I've been searching Google and StackOverflow and did find some partial answers to my problem. Here is my question:
I've bee n trying to make a small script that will promt the user for keywords and once you hit enter it will parse the array into Chrome or Firefox and open up tabs with all the various searches. It works! But, then I wanted to expand on that so I could make a .txt file and make it read from that, that works too! BUT since it's a Japanese site we're searching, Japanese will yield better results!
So I got the ForReading and TriState/Unicode = -1 to work, and it does issue something in Japanese, the problem is it doesn't issue the characters I inserted into the document. :/ And I'm at a loss at the moment. Here's the part of the code that I need some help with:
'Declaring
Option Explicit
Const ForReading = 1
Const Unicode = -1
Dim FullPath
Dim objShell
Dim SearchArray
Dim Figure
Dim Index
Dim listWord
Dim Mandarake
Dim invalidName
Dim rawImport
Dim objFSO
Dim objTextFile
FullPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(FullPath&"\mandalist.txt", ForReading,True,Unicode)
Set objShell = CreateObject("Shell.Application")
SearchArray = Array()
mandarake = "http://ekizo.mandarake.co.jp/shop/en"
'Starting do loop until we trigger the search with "go"
Do
ReDim Preserve SearchArray(UBound(SearchArray)+1)
Figure = InputBox("Enter a name or type 'go' when you're done!", "Figure search", "List")
SearchArray(UBound(SearchArray)) = "http://ekizo.mandarake.co.jp/shop/en/search.do?action=keyword&doujin=all&keyword="&Replace(Figure," ","+")
'Trying to handle empty or "Name" entry into array error
If Figure = Empty Then
invalidName = MsgBox("Are you sure you want to quit?",1,"Are you sure?")
If invalidName = vbOK Then
WScript.Quit (0)
End If
ElseIf Figure = "List" Then
Do Until objTextFile.AtEndOfStream
rawImport = objTextFile.Readline
Figure = Replace(rawImport," ","+")
SearchArray = Split(Figure , ",")
Call objShell.ShellExecute("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe", mandarake, "", "", 1)
For Index = 0 To UBound(SearchArray)
Call objShell.ShellExecute("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe", "http://ekizo.mandarake.co.jp/shop/en/search.do?action=keyword&doujin=all&keyword="&SearchArray(index), "", "", 1)
WScript.Sleep(1500)
Next
WScript.Quit (0)
Loop
I have more code hence all the dims and set's, but that is if the If Figure = "List" is not true and it will then continue to the insertion of manual keywords, and those works even with Japanese signs. The thing is, no matter what I paste into the text file it will parse other characters (also some Japanese stuff) into the URL instead of what I put in. How can I get it to treat the charset as it's supposed to?
Example would be:
Text in Mandalist.txt = グリフォン アスナ
Text in URL in Chrome = 믯낂菣閃苣뎃ꊂ苣誃 - HMF :s
Any help would be much appreciated.
PS - This is my first project where I don't rely on a piece of paper that my teacher wrote me in school, so it may be simple but I just can't make it work.
Thanks
/CuraeL
I need to recursively search for multiple files through the C:\Users directory tree recursively.
If I find any of the specified files in any of the sub-directories, I want to echo out the full path.
Here is what I have:
Dim fso,folder,files,sFolder,newFolder
Dim arr1
arr1 = Array("myFile1.pdf","myFile2.pdf","myFile3.pdf","nutbag.rtf","whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\Users"
Set folder = fso.GetFolder(sFolder)
Set files = folder.SubFolders
For each folderIdx In files
IF (Instr(folderIdx.Name,"Default") <> 1) Then
If (Instr(folderIdx.Name,"All Users") <> 1) Then
newFolder = sfolder & "\" & folderIdx.Name
CopyUpdater fso.GetFolder(newFolder)
End If
End If
Next
Sub CopyUpdater(fldr)
For Each f In fldr.Files
For Each i in arr1
If LCase(f.Name) = i Then
WScript.echo(f.name)
End If
Next
Next
For Each sf In fldr.SubFolders
CopyUpdater sf
Next
End Sub
If I run it as 'Administrator', I get:
VBScript runtime error: Permission Denied
If I run it as 'Local System' user, I get:
VBScript runtime error: Path not found
If I add, 'On Error Resume Next' to the beginning to suppress the errors, I get nothing back.
I have placed a text file called 'whoa.txt' in numerous locations around the C:\Users sub-dirs.
My suspicion is that it is a Windows permissions thing, but I am unsure.
Thanks much.
First I didn't use your code, it confuses me what you are trying to accomplish.
Next you should run the script in Administrator mode command prompt. This should allow you to check if the file is there.
Then paste code below to a vbs file and cscript it. This code displays all the matched filenames.My idea is that instead of going through all files in any folder for a matching filename, check if those wanted files exists in that folder - this is generally faster as some folders contains hundreds of files if not thousands (check your Temp folder!).
Option Explicit
Const sRootFolder = "C:\Users"
Dim fso
Dim arr1
Dim oDict ' Key: Full filename, Item: Filename
Main
Sub Main
arr1 = Array("myFile1.pdf", "myFile2.pdf", "myFile3.pdf", "nutbag.rtf", "whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
' Call Recursive Sub
FindWantedFiles(sRootFolder)
' Display All Findings from Dictionary object
DisplayFindings
Set fso = Nothing
Set oDict = Nothing
End Sub
Sub FindWantedFiles(sFolder)
On Error Resume Next
Dim oFDR, oItem
' Check if wanted files are in this folder
For Each oItem In arr1
If fso.FileExists(sFolder & "\" & oItem) Then
oDict.Add sFolder & "\" & oItem, oItem
End If
Next
' Recurse into it's sub folders
For Each oFDR In fso.GetFolder(sFolder).SubFolders
FindWantedFiles oFDR.Path
Next
End Sub
Sub DisplayFindings()
Dim oKeys, oKey
oKeys = oDict.Keys
For Each oKey In oKeys
wscript.echo oKey
Next
End Sub
Let's say I have a nethood link to a folder with the name "BLABLA" and the target path is "\\servername\temp"
how do I get the string for the target path?
I tried:
Set oShell = CreateObject("WScript.Shell")
Const NET_HOOD = &H13&
Set oShApp = CreateObject("Shell.Application")
sNetHood = oShApp.NameSpace(NET_HOOD).Self.Path
Set oShortCut = oShell.CreateShortcut(sNetHood & "\" & "BLABLA" & ".lnk")
MsgBox "> " & oShortCut.TargetPath
It does everything, even creates a oShortCut object without any errors.
But, it does not return
oShortCut.TargetPath
what am I doing wrong?
I'd like it to return this: "\\servername\temp\BLABLA"
Thanks in advance for any advice!
I've created the shortcut under win 7 with right click in Computer view of the explorer and then > Add a network location > Next ... etc. It creates a Folder representing a shortcut in NetHood to the path on the server ... it's like a mapped share but not really it.
thx for the input ... after years of reading myself into the matter and then checking google once more i found a c# code which i wrote into vbs and then simplified only to see that all i had to change in the end was to add this:
.GetLink
so the solution to my problem is:
Const NET_HOOD = &H13&
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.NameSpace(NET_HOOD)
For Each oFile In oFolder.Items
MsgBox oFile.GetLink.Path
Next
How do I save an entire VB6 project to a new folder? Modules and all. I'm in a position where I need to work with some old VB6 projects. I'd like to save them to a new folder but when I save the project, all that is saved is the vbp file. No modules, no frm files. I want to be able to save all the info to a single folder without moving each BAS file one at a time. Is this even possible?
Addition: The first 2 replies make good sense. But my problem is that the BAS modules seem to be scattered all over the place. Making Windows Explorer do the work a bit tricky. If I have to I will but was looking for an easier way.
Thanks
Given the new "addition" to the question:
Move the VBP and the files in Windows Explorer to a completely new directory.
Open the VBP in a text editor and change any absolute paths to relative paths. VBP files are simple text files, and the format is even documented in the VB6 manual.
Here's an example. This evil VBP below has many absolute paths
Type=Exe
Form=c:\who\knows\where\B_Form.frm
Module=CModule; z:\magic\mapped\network\drive\heehee\C_Module.bas
Class=DClass; x:\personal\usb\stick\D_Class.cls
It would be changed to this benign VBP, which references local copies of the files. You can use relative paths for subdirectories.
Type=Exe
Form=B_Form.frm
Module=CModule; C_Module.bas
Class=DClass; subdirectory\D_Class.cls
If you mean from within Visual Studio, I don't think you can except by doing Save As for each file...
But the simpler approach is to just use Windows Explorer and copy the whole folder structure for the solution into another folder, (or do a recursive "Get" from your source code repository to a different local destination), and then open the solution or project file in the new location... The pointers in the project file that tell Visual Studio where 5all the individual source code and other files are located are generally all stored as relative paths, relative to the folder that the project file is in...
It's been a while since I used VB6, but I'd be tempted to move them using Windows Explorer, then manually edit the VBP file to point to the new locations afterwards. If I remember right, relative paths are fine in the VBP, so you may not even need to manke any changes.
Unbind from source control, if capable/appropriate.
Check into source control as a brand new solution/project
Recursive 'get' from your SCM into a new directory.
There's your new copy.
Create a VB6 Add-in. You can download it from: http://pan.baidu.com/s/1CXO3k
Or you can use below code to create your own.
Option Explicit
Public VBInstance As VBIDE.VBE
Public Connect As Connect
Private Sub CancelButton_Click()
Connect.Hide
End Sub
Private Sub OKButton_Click()
On Error Resume Next
Dim strProject As String
Dim strPath As String
Dim strPath2 As String
Dim strFile As String
Dim strPrjFile As String
Dim rst As VbMsgBoxResult
Dim m, n As Long
Dim col2 As Collection, col As Collection
Dim vbCom As VBComponent
Dim fso As FileSystemObject
Dim ts As TextStream
Dim f1 As String, f2 As String
strProject = Me.VBInstance.ActiveVBProject.FileName
strPath = ParseFileName(strProject, strPrjFile)
strPath2 = setFolder
If strPath = "" Or strPath = strPath2 Then
MsgBox "target folder is invalid or same as the project folder. Can't copy."
Exit Sub
End If
Set col2 = New Collection
Set col = New Collection
Set fso = New FileSystemObject
Set ts = fso.CreateTextFile(strPath2 & "\wemeet.log", False)
For m = Me.VBInstance.ActiveVBProject.VBComponents.Count To 1 Step -1
Set vbCom = Me.VBInstance.ActiveVBProject.VBComponents(m)
For n = 1 To vbCom.FileCount
f1 = vbCom.FileNames(n)
ParseFileName f1, strFile
f2 = strPath2 & "\" & strFile
fso.CopyFile f1, f2
col.Add f1
col2.Add f2
ts.WriteLine "" & Now() & " [Move]: " & f1
ts.WriteLine "" & Now() & " [To ]: " & f2
ts.WriteBlankLines 1
Next
Me.VBInstance.ActiveVBProject.VBComponents.Remove vbCom
Next
For m = 1 To col2.Count
Me.VBInstance.ActiveVBProject.VBComponents.AddFile col2.Item(m)
ts.WriteLine "" & Now() & " [Add]: " & col2.Item(m)
ts.WriteBlankLines 1
Next
Me.VBInstance.ActiveVBProject.SaveAs strPath2 & "\" & strPrjFile
ts.WriteLine "" & Now() & " [SaveAs]: " & strPath2 & "\" & strPrjFile
ts.WriteBlankLines 1
ts.Close
fso.OpenTextFile strPath2 & "\wemeet.log"
Set fso = Nothing
Set col = Nothing
Set col2 = Nothing
Set vbCom = Nothing
Connect.Hide
End Sub
Private Function ParseFileName(ByVal sPath As String, ByRef sFile As String) As String
Dim fso As New FileSystemObject
If fso.FileExists(sPath) Then
ParseFileName = fso.GetParentFolderName(sPath)
sFile = fso.GetFileName(sPath)
Else
ParseFileName = ""
sFile = ""
End If
Set fso = Nothing
End Function
Private Function setFolder() As String
Dim objDlg As Object
Dim objStartFolder As Object
Set objDlg = CreateObject("Shell.Application")
Set objStartFolder = objDlg.BrowseForFolder(&H0, "Select a folder", &H10 + &H1)
If InStr(1, TypeName(objStartFolder), "Folder") > 0 Then
setFolder = objStartFolder.ParentFolder.ParseName(objStartFolder.Title).Path
End If
Set objDlg = Nothing
End Function
I am looking for a method to place some text onto the clipboard with VBScript. The VBScript in question will be deployed as part of our login script. I would like to avoid using anything that isn't available on a clean Windows XP system.
Edit:
In answer to the questions about what this is for.
We wanted to encourage users inside our organization to use the file server to transfer documents instead of constantly sending attachments by email. One of the biggest barriers to this is that it isn't always obvious to people what the correct network path is to a file/folder. We developed a quick script, and attached it to the Windows context menu so that a user can right click on any file/folder, and get a URL that they can email to someone within our organization.
I want the URL displayed in the dialog box to also be placed onto the clipboard.
GetNetworkPath
Another solution I have found that isn't perfect in my opinion, but doesn't have the annoying security warnings is to use clip.exe from a w2k3 server.
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo hello world | clip", 0, TRUE
Example with a multiline string as per question below :
Link1
Dim string
String = "text here" &chr(13)& "more text here"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo " & String & " | clip", 0, TRUE
Using Microsoft's clip.exe is the closest to having a clean Windows XP system solution. However you don't have to call CMD.EXE to host it in order to use it. You can call it directly and write to its input stream in your script code. Once you close the input stream clip.exe will write the contents straight to the clipboard.
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("clip")
Set oIn = oExec.stdIn
oIn.WriteLine "Something One"
oIn.WriteLine "Something Two"
oIn.WriteLine "Something Three"
oIn.Close
If you need to wait for clip to be finished before your script can continue processing then add
' loop until we're finished working.
Do While oExec.Status = 0
WScript.Sleep 100
Loop
And don't forget to release your objects
Set oIn = Nothing
Set oExec = Nothing
The closest solution I have found so far is a method to use IE to get and set stuff on the clipboard. The problem with this solution is the user gets security warnings. I am tempted to move 'about:blank' to the local computer security zone so I don't get the warnings, but I am not sure what the security implications of that would be.
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.document.parentwindow.clipboardData.SetData "text", "Hello This Is A Test"
objIE.Quit
http://www.microsoft.com/technet/scriptcenter/resources/qanda/dec04/hey1215.mspx
No security warnings, full let and get access:
'create a clipboard thing
Dim ClipBoard
Set Clipboard = New cClipBoard
ClipBoard.Clear
ClipBoard.Data = "Test"
Class cClipBoard
Private objHTML
Private Sub Class_Initialize
Set objHTML = CreateObject("htmlfile")
End Sub
Public Sub Clear()
objHTML.ParentWindow.ClipboardData.ClearData()
End Sub
Public Property Let Data(Value)
objHTML.ParentWindow.ClipboardData.SetData "Text" , Value
End Property
Public Property Get Data()
Data = objHTML.ParentWindow.ClipboardData.GetData("Text")
End Property
Private Sub Class_Terminate
Set objHTML = Nothing
End Sub
End Class
Example Usage.
' Create scripting object
Dim WShell, lRunUninstall
Set WShell = CreateObject("WScript.Shell")
WShell.sendkeys "^c"
WScript.Sleep 250
bWindowFound = WShell.AppActivate("Microsoft Excel")
WShell.sendkeys ClipBoard.Data
To avoid the security warnings associated with Internet Explorer and clipboard access, I would recommend you use the Word application object and its methods to put your data onto the clipboard. Of course you can only use this on a machine that has MS Word installed, but these days that's most of them. (*In spite of the fact that you asked for stuff on a 'clean' system :) *)
' Set what you want to put in the clipboard '
strMessage = "Imagine that, it works!"
' Declare an object for the word application '
Set objWord = CreateObject("Word.Application")
' Using the object '
With objWord
.Visible = False ' Don't show word '
.Documents.Add ' Create a document '
.Selection.TypeText strMessage ' Put text into it '
.Selection.WholeStory ' Select everything in the doc '
.Selection.Copy ' Copy contents to clipboard '
.Quit False ' Close Word, don't save '
End With
You can find detail on the MS Word application object and its methods here: http://msdn.microsoft.com/en-us/library/aa221371(office.11).aspx
Microsoft doesn't give a way for VBScript to directly access the clipboard. If you do a search for 'clipboard'on this site you'll see:
Although Visual Basic for Applications supports the Screen, Printer, App, Debug, Err, and Clipboard objects, VBScript supports only the Err object. Therefore, VBScript does not allow you to access such useful objects as the mouse pointer or the clipboard. You can, however, use the Err object to provide runtime error handling for your applications.
So using notepad indirectly is probably about the best you'll be able to do with just VBScript.
Here's another version of using the "clip" command, which avoids adding a carriage return, line feed to the end of the string:
strA= "some character string"
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /C echo . | set /p x=" & strA & "| c:\clip.exe", 2
s = "String: """ & strA & """ is on the clipboard."
Wscript.Echo s
I've only tested this in XP. clip.exe was downloaded from Link and placed in C:\.
I've found a way to copy multi line information to clipboard by vbscript/cmd.
Sequence:
with VBS generate the final "formatted string" that you need copy to clipboard
generate a (txt) file with the "formatted string"
use type command from cmd to paste information to clip by pipe
Example script:
Function CopyToClipboard( sInputString )
Dim oShell: Set oShell = CreateObject("WScript.Shell")
Dim sTempFolder: sTempFolder = oShell.ExpandEnvironmentStrings("%TEMP%")
Dim sFullFilePath: sFullFilePath = sTempFolder & "\" & "temp_file.txt"
Const iForWriting = 2, bCreateFile = True
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO.OpenTextFile(sFullFilePath, iForWriting, bCreateFile)
.Write sInputString
.Close
End With
Const iHideWindow = 0, bWaitOnReturnTrue = True
Dim sCommand: sCommand = "CMD /C TYPE " & sFullFilePath & "|CLIP"
oShell.Run sCommand, iHideWindow, bWaitOnReturnTrue
Set oShell = Nothing
Set oFSO = Nothing
End Function
Sub Main
Call CopyToClipboard( "Text1" & vbNewLine & "Text2" )
End Sub
Call Main
The easiest way is to use built-in mshta.exe functionality:
sText = "Text Content"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True
To put to clipboard a string containing double quote char ", use the below code:
sText = "Text Content and double quote "" char"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(Replace(sText, "\", "\\"), """", """"""), "'", "\'") & "'.replace('""""',String.fromCharCode(34)));close();""", 0, True
Take a look at this post. It describes a hacky approach to read from the clipboard, but I imagine it could be adapted to also write to the clipboard as well, such as changing the Ctrl+V to Ctrl+A then Ctrl+C.
I devised another way to use IE and yet avoid security warnings...
By the way.. this function is in JavaScript.. but u can easily convert it to VBScript..
function CopyText(sTxt) {
var oIe = WScript.CreateObject('InternetExplorer.Application');
oIe.silent = true;
oIe.Navigate('about:blank');
while(oIe.ReadyState!=4) WScript.Sleep(20);
while(oIe.document.readyState!='complete') WSript.Sleep(20);
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>";
var oTb = oIe.document.getElementById('txtArea');
oTb.value = sTxt;
oTb.select();
oTb = null;
oIe.ExecWB(12,0);
oIe.Quit();
oIe = null;
}
Here is Srikanth's method translated into vbs
function SetClipBoard(sTxt)
Set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.value = sTxt
oTb.select
set oTb = nothing
oIe.ExecWB 12,0
oIe.Quit
Set oIe = nothing
End function
function GetClipBoard()
set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.focus
oIe.ExecWB 13,0
GetClipBoard = oTb.value
oTb.select
set oTb = nothing
oIe.Quit
Set oIe = nothing
End function
In your Class ClipBoard, neither the Clear sub nor the Let Data sub work. I mean they have no effect on Windows Clipboard. Actually, and ironically so, the only sub that works is the one you have not included in your example, that is Get Data! (I have tested this code quite a few times.)
However, it's not your fault. I have tried to copy data to clipboard with ClipboardData.SetData and it's impossible. At least not by creating an "htmlfile" object. Maybe it works by creating an instance of "InternetExplorer.Application" as I have seen in a few cases, but I have not tried it. I hate creating application instances for such simple tasks!
Alkis
If it's just text can't you simply create a text file and read in the contents when you need it?
Another alternative and clearly a kludge, would be to use the SendKeys() method.
No security warnings and no carriage return at the end of line
' value to put in Clipboard
mavaleur = "YEAH"
' current Dir
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
' Put the value in a file
Set objFSO=CreateObject("Scripting.FileSystemObject")
outFile=GetPath & "fichier.valeur"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write mavaleur
objFile.Close
' Put the file in the Clipboard
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c clip < " & outFile, 0, TRUE
' Erase the file
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile outFile