I am trying to get a .vbs to download files from google drive as I have had it working as a macro inside excel. It would just be overall easier without needing to go into excel to run the script. I have tried to Frankenstein the working code within the macro which downloads the file to downloads with some other but have got lost. I am still a rookie so if the code is less than ideal would appreciate some feedback.
As a note: The userprofile was attempted to be set as variable for multiple users with differently mapped download folders to still run it.
Ran macro in excel which achieved downloading the file.
Tried to create .vbs with similar code and failed
Option Explicit
Dim FileNum
Dim FileData
Dim MyFile
Dim WHTTP
Dim strDisplayName
Dim oShell
Dim strHomeFolder
Dim vbDirectory
Dim dir
Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
'Set strDisplayName = CreateObject("Scripting.FileSystemObject")
'Set objAD = CreateObject("ADSystemInfo")
'Set objUser = GetObject("LDAP://" & objAD.UserName)
'strDisplayName = objUser.DisplayName
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
MyFile = "https://drive.google.com/open?id=1Hx5DymjrhaiM8Rb7NMP_Sde_JU2N2Rau"
WHTTP.Open "GET", MyFile, False
WHTTP.send
'On Error Resume Next
FileData = WHTTP.ResponseBody
Set WHTTP = Nothing
If Dir(strHomeFolder & "\Downloads", vbDirectory) = Empty Then MkDir strHomeFolder & "\Downloads"
Dim xlApp, xlBook
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Set xlBook = xlApp.Workbooks.Open(strHomeFolder & "\Downloads\External Linking.xlsm", 0, True)
'D:\Users\cdoyle\Desktop\External linking.xlsm
'https://drive.google.com/open?id=1Hx5DymjrhaiM8Rb7NMP_Sde_JU2N2Rau
'"C:\Users\ciara\OneDrive\BayswaterBridge.xlsm"'
xlApp.Run "BridgeHit"
'xlbook.Save False
xlBook.Close False
set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
'WScript.Echo "Finished."
WScript.Quit
Keep getting some errors on If Dir(
line and seem to be chasing my tail.
Related
In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.（.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub
It is my first vbs experience.
I try to keep my Problem short.
This one works, when I run it with my .bat:
Option Explicit
On Error Resume Next
ExcelMacroExample
Sub ExcelMacroExample()
Dim xlApp
Dim xlBook
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\.....\RunScript.xlsm", 0,
True)
xlApp.Run "Auto_Open"
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
And this one works (shows me my corect current directory with my file):
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sScriptDir = oFSO.GetParentFolderName(WScript.ScriptFullName)
Wscript.Echo sScriptDir & "\RunScript.xlsm"
But if I combine them, it does not work:
Option Explicit
On Error Resume Next
ExcelMacroExample
Sub ExcelMacroExample()
Dim xlApp
Dim xlBook
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sScriptDir = oFSO.GetParentFolderName(WScript.ScriptFullName)
Set fileDirectory = sScriptDir & "\RunScript.xlsm"
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(fileDirectory, 0,
True)
xlApp.Run "Auto_Open"
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Like I said, thank you Dave. That works.
However I found another issue, now with vbA inside the RunScript.xlsm
This code works with the vbS before:
Sub Auto_Open()
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
"C:\...\MyCSV.csv" _
, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
ThisWorkbook.Saved = True
Application.Quit
End Sub
But if I change here the path, it just works when I run the RunScript.xlsm, but not when I run my vbS:
Sub Auto_Open()
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
Dim relativePath As String
relativePath = Application.ActiveWorkbook.path & "\MyCSV.csv"
ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
ThisWorkbook.Saved = True
Application.Quit
End Sub
I think it is beacause of the ActiveWorkbook, I tried already ThisWorkbook, and I tried it without Application.
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
Using the following code that I pulled from the web, I'm able to do a search in a single directory for excel files containing a string in a certain row. How would I allow this to be recursive in all the subfolders as well? I've found a few answers but I just don't understand how I would implement them in my code. I only started messing with VBScript yesterday and I'm pretty confused about how to make this work.
strComputer = "CAA-W74109188"
Set objExcel = CreateObject("Excel.Application", strComputer)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='c:\TDRS'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile In FileList
If (objFile.Extension = "xlsm" or objFile.Extension = "xls") Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Name)
Set objWorksheet = objWorkbook.Worksheets(1)
If objExcel.Cells(3,10) = "Complete" or objExcel.Cells(3,9) = "Released" Then
Wscript.Echo objFile.FileName
End If
objExcel.DisplayAlerts = False
objworkbook.Saved = False
objWorkbook.Close False
End If
Next
objExcel.Quit
Here is an script that I used to delete files with, which I have modified for your needs. A recursive function is what you need to get the job done and I have always found them to be interesting and kind of hard to wrap my head around.
Dim Shell : Set Shell = WScript.CreateObject( "WScript.Shell" )
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
Dim Paths(0)
Paths(0) = "c:\temp"
For Each Path in Paths
FolderScan(Path)
Next
Sub FolderScan(Folder)
Set base = oFSO.GetFolder(Folder)
If base.SubFolders.Count Then
For Each folder in Base.SubFolders
FolderScan(folder.Path)
Next
End If
Set files = base.Files
If files.Count Then
For Each File in files
If LCase(oFSO.GetExtensionName(File.Path) = "xlsm") or _
LCase(oFSO.GetExtensionName(File.Path) = "xls") Then
Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Open(File.Path)
Dim objWorkSheet : Set objWorkSheet = objWorkbook.Worksheets(1)
If (objExcel.Cells(3,10) = "Complete" or _
objExcel.Cells(3,9) = "Released") Then
Wscript.echo File.Path
End if
objExcel.DisplayAlerts = False
objExcel.Quit
End If
Next
End If
End Sub
Here's a generic, recursive function that iterates all files and subfolders of a given folder object.
Dim FileSystem
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder("c:\somefolder")
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
' Operate on each file
Next
End Sub
i have this script that reads a list of computers and check to see if the computers have the right software version install. the script echo to me the computers with the wrong version, but i want to make a log instead
Dim strComputer, objFSO, ObjShell, strDisplayName, objList, strObject
Dim objReg, arrSubKeys, strProduct, strVersion, strReqVersion
Const For_Writing = 2
Const ForReading = 1
const ForAppending = 3
Const HKLM = &H80000002
Const strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strReqVersion = "8.2.1 MP2"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objList = objFSO.OpenTextFile("c:\test\test.txt",ForReading)
Do While Not objList.AtEndOfStream
strComputer = objList.ReadLine
If HostOnline(strComputer) = True Then
Inventory(strComputer)
End If
Loop
Function Inventory(strComputer)
Set objTextFile = objFSO.OpenTextFile("c:\test\inventory.txt",2,true)
'creating a dictionary object
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' Enumerate the subkeys of the Uninstall key
objReg.EnumKey HKLM, strKeyPath, arrSubKeys
For Each strProduct In arrSubKeys
' Get the product's display name
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayName", strDisplayName
' Process only products whose name contain 'symantec'
If InStr(1, strDisplayName, "Symantec", vbTextCompare) > 0 Then
' Get the product's display version
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayVersion", strVersion
If strReqVersion <> strVersion Then
WScript.Echo strObject
objDictionary.Add strComputer, strVersion
For Each strObject In objDictionary
WScript.Echo strObject
objTextFile.WriteLine(strObject)
Next
objTextFile.Close
End If
End If
Next
End Function
Function HostOnline(strComputername)
'---------- Test to see if host or url alive through ping -----------------
' Returns True if Host responds to ping
'
' strComputername is a hostname or IP
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim objShell, objFSO, sTempFile, fFile
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = objFSO.GetSpecialFolder(2).ShortPath & "\" & objFSO.GetTempName
objShell.Run "cmd /c ping -n 2 -l 8 " & strComputername & ">" & sTempFile, 0 , True
Set fFile = objFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0
HostOnline = False
Case Else
HostOnline = True
End Select
ffile.close
objFSO.DeleteFile(sTempFile)
Set objFSO = Nothing
Set objShell = Nothing
End Function
can some one help me please thanks
There are several ways to do this. The simplest way, without any modification to your script, would be to call the script with cscript.exe (in a command prompt) and redirect the output to a file:
cscript your.vbs > output.log
However, if you want a log to be created even when users double-click your script you'll have to change your script so that it writes to a file instead of echoing the output. Open the log file at the beginning of the script:
Set myLog = objFSO.OpenTextFile("C:\my.log", For_Writing, True)
replace WScript.Echo ... with myLog.WriteLine ..., and close the file before you exit from the script:
myLog.Close
A somewhat more sophisticated approach would be to create a set of logging functions, which will allow you create log lines depending on certain conditions, e.g. LogInfo() for informational log messages and LogError() for errors.
Shameless plug: Some time ago I got fed up with writing the same boilerplate logging functions over and over again, so I wrote a logger class that encapsulates the usual logging facilities (interactive console, files, eventlog) and provides logging methods for 4 log levels (Error, Warning, Information, Debug). The class can be used for logging to a file like this:
Set myLog = New CLogger
myLog.LogToConsole = False
myLog.LogFile = "C:\my.log"
myLog.LogInfo "info message"
...
myLog.LogError "an error occurred"
The log file is automatically closed when the object is released.
Why not use the system's event log? I described how in this answer
It means most of the work is done for you and you don't need to worry about where to put your log file