VBA executes a .bat but overwrites a cd in the .bat - vba

Heyho, I ran into a strange problem.
I execute a line like this in my VBA:
Shell "path_to_my_bat\batname.bat"
The content of the bat is very simple as well:
cd c:\some_path\
copy *csv newfiles.txt
What it does is simply take all csvs in the directory and merges them into one .txt that I use further down the line in the macro.
The problem is, since I have played around with some vbs scripts it seems I have changed something about how the shell command works.
The "cd" command seems to be skipped, or overwritten by something, the actual second part of the bat is executed in the directory my Workbook is placed in.
Luckily I had a .csv lying there or else I would not have noticed...
The bat on itself works fine if I don't run it from VBA.
The vbs script I played with looks like this (it should open a file and execute a macro in there) :
I think I overwrote some kind of default setting that I should not have tinkered with...
Apart from that I have done nothing I'm aware of to alter something. The macro was working fine this morning, but now because of the bat error it is useless.
' Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")
' Disable Excel UI elements
myExcelWorker.DisplayAlerts = False
myExcelWorker.AskToUpdateLinks = False
myExcelWorker.AlertBeforeOverwriting = False
myExcelWorker.FeatureInstall = msoFeatureInstallNone
' Tell Excel what the current working directory is
' (otherwise it can't find the files)
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = myExcelWorker.DefaultFilePath
strPath = WshShell.CurrentDirectory
myExcelWorker.DefaultFilePath = strPath
' Open the Workbook specified on the command-line
Dim oWorkBook
Dim strWorkerWB
strWorkerWB = strPath & "\YourWorkbook.xls"
Set oWorkBook = myExcelWorker.Workbooks.Open(strWorkerWB)
' Build the macro name with the full path to the workbook
Dim strMacroName
strMacroName = "'" & strPath & "\YourWorkbook" &
"!Sheet1.YourMacro"
on error resume next
' Run the calculation macro
myExcelWorker.Run strMacroName
if err.number <> 0 Then
' Error occurred - just close it down.
End If
err.clear
on error goto 0
oWorkBook.Save
myExcelWorker.DefaultFilePath = strSaveDefaultPath
' Clean up and shut down
Set oWorkBook = Nothing
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will
shut those down also
if myExcelWorker.Workbooks.Count = 0 Then
myExcelWorker.Quit
End If
Set myExcelWorker = Nothing
Set WshShell = Nothing
If it helps, I'm running Windows 8.1 64 bit with Excel 2010 64bit
Got full admin acces etc.

If your current directory is on the D: drive, then cd c:\some_path\ will set the directory for C:, but your current drive will remain somewhere on D:. You need to tell cmd.exe to actually change which drive you are working in.
Simply change your command to
cd /d c:\some_path\
or
pushd c:\some_path\

Related

Filesystemobject Textstream, immediately disappears upon executing Textstream.Close (.vbs extension being created)

I have a situation that is really flummoxing me. Simple code I've used for years is failing in the weirdest way. I have a feeling the cause is related to either anti-virus junk or GPO, but, even those, I have seen them operate before on this scenario--but nothing like how I am seeing it now.
Note - this code has been working perfectly for several people, until one end-user got a new Surface laptop from I.T., purportedly for better compatibility with Teams and 365. ALL users (working, non-working) are on Windows 10.
Scenario:
I'm using Scripting.Filesystemobject
setting an object variable (Textstream intent), as fso.createtextfile
The filepath (name) I am creating is actually filename.vbs...At the moment this line executes, I can see the vbs file successfully in the folder
I use Textstream.Write to put some content in the file
I then use Textstream.Close (normally at this point you get a solid, stable, useable file). Immediately upon execution of the last line, Textstream.Close, the file DISAPPEARS from the folder-GONE.
The folder I'm writing to is the same as Start > Run > %appdata%
I've also tried this in Documents folder (Environ$("USERPROFILE") & "\My Documents") and get the exact same result
I've seen group policies and AV stuff that will prevent VBS from running, but that isn't my case--I've tested with this user, and she has no problem:
Creating a txt file in either of those folders
Manually creating a .vbs file in either of those folders
Even RUNNING the resulting vbs file in either folder
But somehow when I programmatically create .VBS in code, the second I close the textstream, the file is gone from the folder.
Any insight? The internet searches I did were void of all information on this scenario!! It would take me 2 weeks to open a ticket and get any help from I.T.
This is Excel VBA, but I highly doubt the problem has anything to do with Excel nor VBA...this is standard usage of windows scripting.filesystemobject:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'initiate full backup vbs script:
Dim ts As Object, fso As Object, strScriptText As String, strScriptPath As String
'populate our variable with the full text of the script: found on QLoader in this range:
strScriptText = ThisWorkbook.Worksheets("QLoader").Range("z_BackupScriptText").Value
'replace the text "placeholder" with this workbook's actual full path/name:
strScriptText = Replace(strScriptText, "placeholder", ThisWorkbook.FullName)
'fire up FSO:
Set fso = CreateObject("scripting.filesystemobject")
'determine the new VBS file's path
strScriptPath = Environ("AppData") & "\Backup_" & Format(Now, "yymmddhhmmss") & ".vbs"
'create our textstream object:
Set ts = fso.createtextfile(strScriptPath)
'write our script into it
ts.write strScriptText
'save and close it
ts.Close 'RIGHT HERE THE FILE DISAPPEARS FROM THE FOLDER ***********
'GO:
Shell "wscript " & strScriptPath, vbNormalFocus
End Sub
It does look like an antivirus thing...
If the issue is just the vbs extension though, you can use something like this:
Sub tester()
Dim ts As Object, fso As Object, strScriptText As String, strScriptPath As String
Set fso = CreateObject("scripting.filesystemobject")
strScriptPath = Environ("AppData") & "\Backup_" & Format(Now, "yymmddhhmmss") & ".txt"
Set ts = fso.createtextfile(strScriptPath)
ts.write "Msgbox ""Hello"""
ts.Close
'need to specify the script engine to use
Shell "wscript.exe /E:vbscript """ & strScriptPath & """ ", vbNormalFocus
End Sub

Open another workbook with vba that contains all the macros

Instead of having all the macro's stored in each workbook, we would like to have them stored in one global one. We tried using Personal.xlsb file, however every time excel crashes or system administrator forced restart with excel open it created personal.v.01 ....v.100 files, and they interfered with each other, got corrupted etc.. So instead we are trying to add a small macro to each excel workbook we make which then should open a global excel workbook with all the macros, however it does not open it(normal.xlsb), where is the problem? If I manually run it it works fine, it just does not autorun..
Option Explicit
Public Sub Workbook_Open()
Dim sFullName As String
Dim xlApp As Excel.Application
Dim wbReturn As Workbook
sFullName = "Z:\Dokumentstyring\normal.xlsb"
Set xlApp = GetObject(, "Excel.Application") 'need to do so to open it in same instance otherwise the global macros can not be called.
Set wbReturn = xlApp.Workbooks.Open(filename:=sFullName, ReadOnly:=True)
If wbReturn Is Nothing Then
MsgBox "Failed to open workbook, maybe z drive is down?"
Else
ThisWorkbook.Activate'Dont know how to pass object to modules, so instead activate it and in createbutton set wb= activeworkbook..
Application.Run ("normal.xlsb!CreateButtons")
End If
End Sub
Public Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wb As Workbook
For Each wb In Application.Workbooks
If InStr(UCase(wb.Name), "PARTSLIST") > 0 And wb.Name <> ThisWorkbook.Name Then Exit Sub
Next wb
On Error Resume Next
Workbooks("normal.xlsb").Close
Workbooks("filter.xlsx").Close
End Sub
You create your addin, as just an empty workbook, holding nothing but the code
Like this
Then you add a reference to it, in the workbook that you wish to use, in VBA, like this. My Documents, is a folder on a network drive, not "my documents" local.
And then you can call like so.
So based on input from #Nathan_Sav and #Ralph I have come to a partly good solution:
I have called my addinn Normal and saved this on Z:Dokumenstyring\Normal.xlam
I then removed all the code in Thisworkbook of Normal:
Private Sub Workbook_Open()
Dim ExcelArgs As String
Dim arg As String
ExcelArgs = Environ("ExcelArgs")
'Call deleteMacros.deletePersonalFiles
'MsgBox ExcelArgs
If InStr(UCase(ExcelArgs), "CREO,") > 0 Then
Application.DisplayAlerts = False
If Len(ExcelArgs) > Len("CREO,") Then
arg = Split(ExcelArgs, ",")(1)
Call Creo.addNewPartToPartslist(arg)
End If
Application.DisplayAlerts = True
End If
If InStr(UCase(ExcelArgs), "DOKLIST,") > 0 Then
Application.DisplayAlerts = False
If Len(ExcelArgs) > Len("DOKLIST,") Then
arg = Split(ExcelArgs, ",")(1)
Call ProsjektListen.dbDumpDocOut(arg)
End If
Application.DisplayAlerts = True
End If
and put this in a new workbook called Z:Dokumenstyring\Creo.xlsm
I have so edited all my bat files(which previously were using personal.xlsb):
echo "Launch excel"
Set ExcelArgs=CREO,ADDPART
"C:\Program Files (x86)\Microsoft Office\OFFICE16\Excel.exe" /x /r "z:\Dokumentstyring\Creo.xlsm"
So when I run the bat file it adds a parameter to enviroment, start creo.xlsm, which then starts the addin which launch my userform.
So if I now want to update the look of that that userform I do this by modifying the Z:Dokumenstyring\NormalDebug.xlam, then i save a copy which i write over Z:Dokumenstyring\Normal.xlam and I also told every user to not copy the addin to the default location in excel but keep it in Z:Dokumenstyring\Normal.xlam.
My shapes in my excel sheets seems to work with just the macro name in the procedure, however there might be an conflict if two procedures have the same name, but located in different procedures. So I also altered this to
ws1.Shapes(tempName).OnAction = "Normal.xlam!Custom_Button_Click"
However every click starts a new instance of the addin, how to avoid this?

Is it possible to associate an Excel Macro with a file extension?

I have built a macro for building and running SQL Queries. I am pretty happy with it so far. The only thing I would like to add is the ability in Windows to double click a .sql file and it opens inside the macro. Sample is below:
This is the code that opens an SQL file when Load Query is pressed.
Sub LoadQuery()
Dim fNameAndPath As Variant
fNameAndPath = Application.GetOpenFilename(FileFilter:="SQL Query Files (*.sql), *.sql", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Open fNameAndPath For Input As #1
Sheets("Sheet1").SQL_Query = Input$(LOF(1), 1)
Close #1
Sheets("Sheet1").SQLFileName.Caption = fNameAndPath
End Sub
Is this even possible? I don't think it will be but thought I would check with you guys first.
What have I tried so far? Nothing, because I don't even know where to start, Uncle Google didn't hook a brother up in fact he just confused me even more.
Using the ideas below I went with this:
Option Explicit
Dim xlApp, xlBook, fNameAndPath
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("G:\Analytics Reporting Archive\SQL Client.xlsm", 0, True)
xlApp.Open WScript.Arguments(0) For Input As #1
xlBook.Sheets("Sheet1").SQL_Query = Input$(LOF(1), 1)
xlApp.Close #1
xlBook.Sheets("Sheet1").SQLFileName.Caption = fNameAndPath
Set xlBook = Nothing
Set xlApp = Nothing
WScript.Quit
This didn't work, it didn't like opening the text file (sql file) so I went with creating a small routine in the Excel app:
Sub LoadQueryDBLClick(QueryFileName As String)
Open QueryFileName For Input As #1
Sheets("Sheet1").SQL_Query = Input$(LOF(1), 1)
Close #1
Sheets("Sheet1").SQLFileName.Caption = fNameAndPath
End Sub
This is then called in the VBS like so:
Option Explicit
Dim xlApp, xlBook, fNameAndPath
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("G:\Analytics Reporting Archive\SQL Client.xlsm", 0, True)
xlApp.Run "LoadQueryDBLClick " & WScript.Arguments(0)
Set xlBook = Nothing
Set xlApp = Nothing
WScript.Quit
Brilliant right?
NO :(. It "would" work, of that I am confident (and extremely grateful to you guys that posted replies for me that got me this far) but alas Citrix strikes again:
Error: ActiveX component can't create object: 'Excel.Application'
I am confident that you guys have solved this in that Citrix is now the issue.
See here for how to create a custom extension and associate it with an action.
https://superuser.com/questions/406985/programatically-associate-file-extensions-with-application-on-windows
What might work in your case is to associate the extension with a vbs file which takes the launching SQL filepath as a parameter and opens your Excel file using automation, then loads the SQL file into the workbook.
You'll want to right-click on an SQL file and select Open With. Choose, or browse to Excel.exe. Set it as the default application to open SQL files with.
This will open your SQL files in Excel.
From here you'll need to teach your macro to detect when it was launched by an SQL file and run as desired.

Opening and Excel file in Access using VBA and saving it to a different name and closing it properly

I have been searching for some time on how exactly to go about this, but I keep coming up with a large number of possible ways that come close, but never really give me exactly the sort of thing I'm looking for. The concept is pretty simple I need to open a certian .xls file using some VBA code in Access 2010. Once the file is opened I need to insert data and do some things to the file then save the file as a different filename and close the file. I also need it to close excel if it was not already open and if it was open I need it to leave excel alone and not save/close anything other than the template.xls file I am working with. I currently have code that will do part of this provided Excel is not already open at the time the script runs. When excel is already opened I get the following error;
"Run-time'91': Object variable or With block variable not set."
When I click debug I get the following line highlighted
x.ActiveWorkbook.SaveAs fileName:=savedfilename
Here is the code without all the junk that doesn't relate to the issue. I have cobbled together using examples from various sites.
Dim DateSampled As String
Dim strPath As String
Dim TemplatePath As String
Dim x As Excel.Application
Dim xBook As Excel.Workbook
Dim xSheet As Excel.Worksheet
DateAsString = Format(DateSampled, "MMDDYYYY")
savedfilename = strPath & "\" & TrainNum & "-" & DateAsString & ".xls"
TemplatePath = "B:\template.xls"
Set x = CreateObject("Excel.Application")
x.Visible = False
Set xBook = GetObject(TemplatePath)
xBook.Windows(1).Visible = True
Set xSheet = xBook.Worksheets(1)
'---------------CODE DOES STUFF WITH THE FILE -----------------------
x.DisplayAlerts = False
x.ActiveWorkbook.SaveAs fileName:=savedfilename
x.DisplayAlerts = True
x.ActiveWorkbook.Close
Set x = Nothing
Set xBook = Nothing
Set xSheet = Nothing

VBScript - How to make program wait until process has finished?

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