I am trying to ping a server before uploading a file with ftp. Recently, a client complained that the process was freezing. I tested the ping process with a vbscript file just to make sure something wasn't broken on the computer. The vbscript worked just fine. So I ran the script from the Access database and it hung just the same as it did before. Is there something about the ping exe that I am missing here?
Vbscript that runs just fine when you double click it.
Const fsoForWriting = 2
Dim oShell, ping, strPath, strPing
Set oShell = WScript.CreateObject ("WScript.Shell")
Set ping = oShell.exec("ping -n 2 -w 750 google.com")
Do While ping.Status = 0
WScript.Sleep 100
Loop
strPing = ping.StdOut.ReadAll
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextFile = objFSO.GetParentFolderName(strPath) & "\PingResults.txt"
Set objTextStream = objFSO.OpenTextFile(strTextFile, fsoForWriting, True)
objTextStream.WriteLine strPing
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
Set oShell = Nothing
VBA function that runs on the test database on startup. This is the code that hangs.
Function fFtpOnline(ByVal ComputerName As String)
On Error GoTo ErrHandler
Dim oShell, ping
Set oShell = CreateObject("WScript.Shell")
Set ping = oShell.exec("cscript " & Access.CurrentProject.Path & "\" & "Test.vbs")
Do While ping.Status = 0
DoEvents
Loop
Set oShell = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description & " " & "fFtpOnline "
Resume Next
End Function
This code works fine on my computer but on the client's computer, the code hangs.
This may sound like a rude answer, but by no means is it intended to be. Just as the comment above stated, this is more than likely it issue on your customer's end. If the program works currently on your end and not theirs they have the issue, not the code. I've run into plenty of customers who are clueless so unless they are willing to let you take control of their machine remotely I would recommend them capturing some information for you. ipconfig is a good place to start. And while they are at the command prompt have them try to ping some places. I know this is not a true answer, but it is what I have encountered in the past.
Related
I was just upgraded to windows 10. This version of outlook I have enabled the macros in the trust center however it limits me on running vba from outlook. Also access is having issues when I run the task scheduler and run from a bat file the access database. An autoexec excutes and I tell the system to shut outlook down but it won't shut down the current instance of the outlook. Here Is the code I am using.
Public Function OutlookClose1()
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess In colProcessList
Set objOutlook = GetObject(Class:="Outlook.application")
objOutlook.Quit
Next
End Function
Public Function OutlookClose2()
Dim objAppOL As Outlook.Application
On Error Resume Next
Set objAppOL = GetObject(Class:="Outlook.application")
objAppOL.Quit
Set objAppOL = Nothing
Exit Function
End Function
I have tried outlookclose1 and 2 and neither work. DOes anyone have suggestions?
Also when running the outlookclose1 from the vba editor it does close. It takes the exchange offline, which I don't want. But from a bat file running the access database and having the autoexec run it it doesn't close down outlook.
Task scheduler runs as a service in a security context different from the currently logged in user even if the local user account is the same. COM system refuses to marshal calls between processes running in different security contexts.
I have office 2013 and windows 10. I could use the above code with Windows 7 and the task scheduler. I am on a domain with certain policies that I can't change and I don't have admin rights. At home not on a domain I can use that code too. With that being said I can at least terminate outlook from access and get the job done closing an outlook session so when the autoexec runs in the access database it closes outlook and then runs the reports and sends, Create Object Outlook.Application and it sends emails no problems. Here is how I terminate the code. The reason is I don't want multiple outlook sessions running.
Public Function OutlookClose1()
Dim objOutlook As Outlook.Application
delay = 30000 'delay in milliseconds to let Outlook close gracefully
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess In colProcessList
objProcess.Terminate
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
Set colProcessList = Nothing
End Function
I spend hours finding the problem.
I want to start the SAP Logonpad with the ini file, that works fine.
Then after binding to the scripting object I want to open the connection to a specific System with connection = SapGui.OpenConnection("SID", True)
but always get runtime error 70 access denied.
I followed what others seem to do with vbs, for certain resons I can't do it with vbs and have to go with vba, so maybe there might be some difference that makes it fail?
Any advice would be highly appreciated.
Private Sub CommandButton1_Click()
Dim SapGui As Object
Dim saplogon As Object
Dim connection 'As Object
Set SapGui = GetObject("SAPGUI")
Dim Wshshell As Object
Set Wshshell = CreateObject("Wscript.Shell")
Wshshell.Run Chr(34) & ("C:\Program Files\SAPPC\FrontEnd\SAPgui
\saplogon.exe") & Chr(34) & " " & "/INI_FILE" & "=" & Chr(34) &
"\\longpathtoini\appl\Sap\saplogon\int\saplogon.ini" & Chr(34)
Do Until Wshshell.AppActivate("SAP Logon")
Application.Wait Now + TimeValue("0:00:01")
Loop
Set Wshell = Nothing
Set saplogon = SapGui.GetScriptingEngine
connection = SapGui.OpenConnection("SID", True)
Set SapGui = Nothing
Set saplogon = Nothing
Set connection = Nothing
End Sub
Check whether user scripting is allowed for the particular system (transaction RZ11, parameter sapgui/user_scripting). Also be aware that for some versions, you'll apparently need to specify the SAP Logon entry text instead of the SID.
Thanks to vwegert.
I surely knew about scripting needs to be enabled on the servers.
Which is, but at the moment I read his answer I remembered that in my SAP GUI settings the checkbox for "Warn if a script tries to connect" was enabled.
Disabeling that options did lead to success.
The above code works perfectly.
I made a script that copying a file to a certain location.
I add the .vbs to taskschd.msc scheduled for make a .pst backup
but I get error message
Line: 91
Char: 7
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error
<pre>
'Set the amount of pst-files you want to copy. Start counting at 0!
ReDim pst(1)
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de#teknotrans.se.pst"
pst(1) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de.pst"
'Define your backup location
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
'Keep old backups? TRUE/FALSE
KeepHistory = FALSE
'Maximum time in milliseconds for Outlook to close on its own
delay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
start = TRUE
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(delay)
'Outlook is closed, so we can start the backup
Call BackupPST(pst, BackupPath, KeepHistory)
'Open Outlook again when desired.
If start = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(delay)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each Process in objWMIService.InstancesOf("Win32_Process")
If StrComp(Process.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
set colProcessList = Nothing
End Sub
Sub BackupPST(pst, BackupPath, KeepHistory)
Set fso = CreateObject("Scripting.FileSystemObject")
If KeepHistory = True Then
ArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
BackupPath = BackupPath & ArchiveFolder & "\"
End If
If fso.FolderExists(BackupPath) = False Then
fso.CreateFolder BackupPath
End If
For Each pstPath in pst
If fso.FileExists(pstPath) Then
fso.CopyFile pstPath, BackupPath, True
End If
Next
Set fso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
</pre>
Could someone help me to solve this?
Thank you in advance
Seems like you schedule the script.
You need to start the task with a user that executes the script which has rights on the PST file, as well as on the path where you store the backup. Running it with the system account won't be enough.
There are better ways to backup PST files also, I use a Ruby script to synchronise a local copy with a backup copy, is runs on PST's more than 10GB big without problem, might be a problem if you would do it with a copy like this.
You need to backup the copy on a backup medium also because when the PST has errors (and all big PST have) you copy the errors to the backup and could lose both.
Also, you do the following
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
...
BackupPath = BackupPath & ArchiveFolder & "\"
Where is the \ between the two first variables ?
EDITED: Change the permissions of the folder.
In windows explorer, navigate to the folder where the PST file is located.
In the left pane of windows explorer, right click on the folder where the PST file is located, select "Properties".
Select the "Security" tab
Click the button "Edit" to change permissions.
Click "Add"
In the object names to select box, enter "everyone" (no quotes).
Click "Check Names", everyone should become capitalized and underlined.
Click "Ok"
Select "Everyone" from the list of Groups or user names.
In the "Permissions for Everyone" list, make sure "Read & Execute, List folder contents and Read, in the allow column are checked, click "Apply"
Click Ok.
NOTE: By doing this, anyone who has access to this computer can access the folder. You might consider only adding your login to the computer to the list of Groups or usernames instead of Everyone. You may have to repeat the above steps on the PST file(s) in question.
Original Post:
I ran the script here, testing for various issues and it ran without problems. At this point I believe the issue is rights and permissions to either the source or destination folder (or the files you are backing up). By default, the user's themselves don't have access to Outlooks data files. You would need to add "read" permissions to the files in question (PST,OST, and so on) or the full folder.
In reality, just backing up the PST files isn't enough to restore an Outlook configuration; you would need all of the files.
You can Try this:
'===================================================================
'Description: VBS script to backup your pst-files.
'
'Comment: Before executing the vbs-file, set the location of outlook
' folder you want to backup and
' the backup location (this can also be a network path).
' See the URL below for more configuration instructions and
' how to create a Scheduled Task for it.
'
' Original author : Robert Sparnaaij
' Modified: Fred Kerber
' version: 1.1
' website: http://www.howto-outlook.com/downloads/backupscript.htm
' Changes:
' Changed var types; changed to backup full folder and not just pst files.
'===================================================================
'===================BEGIN MODIFY====================================
'Define the folder location of Outlook's data files.
sOutlookDataPath = "C:\Users\FKerber.CORP\AppData\Local\Microsoft\Outlook\"
'Define your backup location
sBackupPath = "E:\Outlook Backup\"
'Keep old backups? TRUE/FALSE
bKeepHistory = TRUE
'Maximum time in milliseconds for Outlook to close on its own
iDelay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
bStart = True
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(iDelay)
'Outlook is closed, so we can start the backup
Call BackupOutlook(sOutlookDataPath, sBackupPath, bKeepHistory)
'Open Outlook again when desired.
If bStart = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(iDelay)
Set objWMIService = GetObject("winmgmts:" &_
{impersonationLevel= impersonate}!\\.\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each oProcess in objWMIService.InstancesOf("Win32_Process")
If StrComp(oProcess.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
Set colProcessList = Nothing
End Sub
Sub BackupOutlook(sOutlook, sBackupPath, bKeepHistory)
Set ofso = CreateObject("Scripting.FileSystemObject")
If bKeepHistory = True Then
sArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
sBackupPath = sBackupPath & sArchiveFolder & "\"
Else
For Each oFile In ofso.GetFolder(sBackupPath).Files
ofso.DeleteFile oFile.Path, True
Next
End If
If ofso.FolderExists(sBackupPath) = False Then
ofso.CreateFolder sBackupPath
End If
For Each oFile In ofso.GetFolder(sOutlook).Files
If ofso.FileExists(oFile.Path) Then
ofso.CopyFile oFile.Path, sBackupPath, True
End If
Next
Set ofso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
I had a similar problem trying to delete files with VBS. I assume that as with my case: The source of the problem is that the script is trying to perform some operation on a file or folder that has a Read-only Attribute. To solve this manually you could left click -> properties -> unclick the Read-Only Attribute then the file/folder should be copied by the script. To solve the problem with VBS: I make the assumption that file/folder is set to Read-Only because there is a programme currently using them.
One: we can just skip files/folders set to read-only this time and hope to get them next time the script runs. For this we first check if file/folder is read-only (I got this from here: https://social.technet.microsoft.com/Forums/ie/en-US/7382d452-1ef9-404a-8874-48d38fcfe911/vbscript-verify-if-a-file-is-readonly?forum=ITCG), if not then we perform the copy operation.
Sub BackupPST(pst, BackupPath, KeepHistory)
'........
For Each pstPath in pst
If fso.FileExists(pstPath) Then
If not (fso.GetFile(pstPath).Attributes AND 1) Then 'if item is not read-only
fso.CopyFile pstPath, BackupPath, True
End If
End If
Next
Set fso = Nothing
End SubSub
Two: At the very least this should prevent you from getting the error. But if the script never moves the files even after running a number of times then chances are that the files (you are trying to move) are always in read only and you should change Attribute of the file (you are trying to move) in your script before calling the copy function, see how to do that here: https://devblogs.microsoft.com/scripting/how-can-i-change-a-read-only-file-to-a-read-write-file/
I've been tasked with creating a vbs to do the following:
If NewAdmin exists then Set password for NewAdmin and disable Local Administrator account
Else Rename local Administrator account to NewAdmin and set password.
Thanks again for the quick reply. I have changed the code below accordingly and am now trying to use the Windows Script Encoder to obfuscate the password. I understand that there is still a risk involved as this could be decoded, but the script will not be stored on the user's computer and as such will not pose much of a threat.
The code now shows the three added lines needed for the Windows Script Encoder to do it's job, but I can't get it to work. I run the following command from the command line:
screnc /l vbscript admin_script.vbs admin_script.vbe
It creates the admin_script.vbe successfully. But then when I attempt to run the encoded script it presents the following error message:
Script: C:\...\admin_script.vbe
Line: 2
Char: 1
Error: Expected Statement
Code: 800A0400
Source: Microsoft VBscript compilation error
The unencoded script runs without issues. I have tried another method to encode the data using a vbscript I located online, but it does the same thing ... obfuscates the data but the script doesn't work afterwords. I also read that it may be an encoding issue and that I needed to save the vbs as UTF-8 without BOM but that didn't work either.
If anyone knows how to get this Windows Script Encoder working I would greatly appreciate it. Also, if there is another method for encrypting / obfuscating the code, any suggestions are welcome. I will say that I'm not a big fan of creating an executable from VBS, but will resort to that if necessary.
<SCRIPT LANGUAGE="VBScript">
'**Start Encode**
OPTION EXPLICIT
DIM objNetwork, objUser, objComputer
DIM strPassword, strAdminUserName, strNewAdminUserName, strComputer, strUser
' Get Computer Name and make it all uppercase
SET objNetwork = CREATEOBJECT("Wscript.Network")
strComputer = UCASE(objNetwork.ComputerName)
' Setting veriable for IF statement
strUser= "NewAdmin"
' The old name of the administrator user account (normally administrator)
strAdminUserName = "Administrator"
' The new name of the administrator user account
strNewAdminUserName = "NewAdmin"
' New Password for administrator account.
strPassword = "passwordhere"
On Error Resume Next
Set objUser = GetObject("WinNT://" & strComputer & "/" & strUser & ",user")
If (Err.Number = 0) Then
On Error GoTo 0
' Set password of admin user account
setPWD strComputer,strNewAdminUserName,strPassword
' Disable Local Administrator account
Set objUser = GetObject("WinNT://" & strComputer & "/Administrator, user")
objUser.AccountDisabled = True
objUser.SetInfo
Else
On Error GoTo 0
' Rename admin user account
renameUser strComputer,strAdminUserName,strNewAdminUserName
' Set password of admin user account
setPWD strComputer,strNewAdminUserName,strPassword
End If
' enter code hereReset password for a local user account on a given computer
SUB setPWD(strComputer,strUser,strPassword)
DIM objUser
' Ignore error if user account isn't found or error changing password
ON ERROR RESUME NEXT
SET objUser = GETOBJECT("WinNT://" & strComputer & "/" & strUser & ",user")
IF err.number = 0 THEN
objUser.SetPassword strPassword
objUser.SetInfo
END IF
ON ERROR GOTO 0
END SUB
' Rename a local user account on a given computer
SUB renameUser(strComputer,strFromName, strToName)
DIM objComputer,objUser
' Ignore error if user account isn't found or error moving user
ON ERROR RESUME NEXT
SET objComputer = GETOBJECT("WinNT://" & strComputer)
SET objUser = GETOBJECT("WinNT://" & strComputer & "/" & strFromName & ",user")
IF err.number = 0 THEN
objComputer.MoveHere objUser.ADsPath,strToName
END IF
ON ERROR GOTO 0
END SUB
</SCRIPT>
change this
If (Err.Number <> 0) Then
to this
If (Err.Number = 0) Then
I have a problem in a VBScript that I am using with a VBA/Excel macro and a HTA. The problem is just the VBScript, I have the other two components, i.e. the VBA macro and HTA front-end working perfectly. But before I explain the problem, I think for you to help me I must help you understand the context of the VBScript.
So, basically all components (VBScript, VBA macro and HTA) are parts of a tool that I am building to automate some manual chores. It pretty much goes like this:
A - HTA
~~~~~~~~~~~~
User selects some files from the HTA/GUI.
Within the HTML of the HTA there is some VBScript within the "SCRIPT" tags which passes the users 4 input files as arguments to a VBScript (executed by WScript.exe - you may refer to note #1 for clarity here)
The script, lets call it myScript.vbs from now on then handles the 4 arguments, 3 of which are specific files and the 4th is a path/folder location that has multiple files in it - (also see note #2 for clarity)
B - myScript.vbs
~~~~~~~~~~~~
myScript.vbs opens up the first 3 arguments which are Excel files. One of them is a *.xlsm file that has my VBA macro.
myScript.vbs then uses the 4th argument which is a PATH to a folder that contains multiple files and assigns that to a variable for passing to a FileSystemObject object when calling GetFolder, i.e.
... 'Other code here, irrelevant for this post
Dim FSO, FLD, strFolder
... 'Other code here, irrelevant for this post
arg4 = args.Item(3)
strFolder = arg4
Set FSO = CreateObject("Scripting.FileSystemObject"
'Get a reference to the folder you want to search
Set FLD = FSO.GetFolder(strFolder)
...
From here I create a loop so that I can sequentially open the files within the folder
and then run my macro, i.e.
...
Dim strWB4, strMyMacro
strMyMacro = "Sheet1.my_macro_name"
'loop through the folder and get the file names
For Each Fil In FLD.Files
Set x4WB = x1.Workbooks.Open(Fil)
x4WB.Application.Visible = True
x1.Run strMyMacro
x4WB.close
Next
...
Please note that when the first 3 Excel files have opened (controlled by code prior to the loop, and not shown here as I am having no problem with that part) I must keep them open.
It is the files in the folder (that was passed as the 4th argument) which must sequentially open and close. But inbetween opening and closing, I require the VBA/macro (wrote in one of the 3 Excel files previously opened) to run each time the loop iterates and opens a new file from the folder (I hope you follow - if not please let me know :) ).
The problem I am having is that the files in the folder open and close, open and close, n number of times (n = # of files in folder, naturally) without waiting for the macro to run. This is not what I want. I have tried the WScript.sleep statement with a 10 second delay after the 'x1.Run strMyMacro' statement, but to no avail.
Any ideas?
Thanks,
QF.
NOTES:
1 - For simplicity/clarity this is how:
strCMD = cmd /c C:\windows\system32\wscript.exe myScript.vbs <arg1> <arg2> <arg3> <arg4>
'FYI - This is run by creating a WShell object, wsObj, and using the .run method, i.e. WShell.run(strCMD)
2 The HTA employs a piece of JavaScript that strips the users 4th input file (HTML: INPUT TYPE="file") and passes that to the the VBScript within the HTA. This gets me round the problem of not being able to exclusively select a FOLDER in HTML.
You need to tell the run to wait until the process is finished. Something like:
const DontWaitUntilFinished = false, ShowWindow = 1, DontShowWindow = 0, WaitUntilFinished = true
set oShell = WScript.CreateObject("WScript.Shell")
command = "cmd /c C:\windows\system32\wscript.exe <path>\myScript.vbs " & args
oShell.Run command, DontShowWindow, WaitUntilFinished
In the script itself, start Excel like so. While debugging start visible:
File = "c:\test\myfile.xls"
oShell.run """C:\Program Files\Microsoft Office\Office14\EXCEL.EXE"" " & File, 1, true
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
objWMIService.Create "notepad.exe", null, null, intProcessID
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredProcesses = objWMIService.ExecNotificationQuery _
("Select * From __InstanceDeletionEvent Within 1 Where TargetInstance ISA 'Win32_Process'")
Do Until i = 1
Set objLatestProcess = colMonitoredProcesses.NextEvent
If objLatestProcess.TargetInstance.ProcessID = intProcessID Then
i = 1
End If
Loop
Wscript.Echo "Notepad has been terminated."
This may not specifically answer your long 3 part question but this thread is old and I found this while searching today. Here is one shorter way to: "Wait until a process has finished." If you know the name of the process such as "EXCEL.EXE"
strProcess = "EXCEL.EXE"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '"& strProcess &"'")
Do While colProcesses.Count > 0
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '"& strProcess &"'")
Wscript.Sleep(1000) 'Sleep 1 second
'msgbox colProcesses.count 'optional to show the loop works
Loop
Credit to: http://crimsonshift.com/scripting-check-if-process-or-program-is-running-and-start-it/
Probably something like this? (UNTESTED)
Sub Sample()
Dim strWB4, strMyMacro
strMyMacro = "Sheet1.my_macro_name"
'
'~~> Rest of Code
'
'loop through the folder and get the file names
For Each Fil In FLD.Files
Set x4WB = x1.Workbooks.Open(Fil)
x4WB.Application.Visible = True
x1.Run strMyMacro
x4WB.Close
Do Until IsWorkBookOpen(Fil) = False
DoEvents
Loop
Next
'
'~~> Rest of Code
'
End Sub
'~~> Function to check if the file is open
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function