Executing Excel macro on/from specific open file - excel

I've got a need to open some Excel files and "pause" then close them. In this process I run one macro on opening, and another on closing. The opening one works fine because it is done as each file is opened. But the closing part of the code I can't get it to run the correct macro. They have the same names, but the file contests are different, and what the macro does per file is different.
This is the gist of what I'm doing now
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
path = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
filename2018P1 = "2018 P1.xlsm"
Set xlbook2018P1 = xlApp.WorkBooks.Open(path & filename2018P1)
' Run Macro
xlApp.Run "AutoRefresh"
filename2018P3 = "P3 2018 HRR.xlsm"
Set xlbook2018P3 = xlApp.WorkBooks.Open(path & filename2018P3)
'Run Macro
xlApp.Run "AutoRefresh"
'My "pause"
WScript.Echo ("All Files were" & Chr(013) & _
"opened and refreshed, update ppt before OK" & Chr(013) & _
" DO NOT CLICK OK" & Chr(013))
'==========================
'Below is the trouble spot.
'==========================
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing
The first part works fine, but trying to run the file's respective AutoPublish macro does not. The code works fine if I leave out that Run line. (The real file names have spaces and I had to add the single quotes to get it to accept the filename.)
What it appears to be doing is using the macros from the last file opened, not the one it's directed to use it the run line. I think I need a way to "select" the correct file, or give it focus so the macro could run without an explicit filename argument, which it appears to be ignoring anyway.
EDIT:
Solution was:
xlbook2018P1.Activate ' This fixed it, I think
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlbook2018P3.Activate
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing

When tackling similar tasks, I usually work around by implementing a master Excel file first, and call a sub in this master file via VBS. The advantage to me seems it is way easier to fullfill all tasks in the VBA of the master file rather than having to code all that in VBS.
Create a master file, e.g. "Master.xlsm", list all your files you need to open on a sheet named "Files" in column A, starting in row 1.
Insert a module and place the following sub in this module:
Sub Main()
Dim strPath As String
Dim strFile As String
Dim lRow As Long
Dim i As Long
Dim k As Integer
Dim n As Long
Dim wb(1 To 3) As Workbook
Dim wbTest As Workbook
Set wbMaster = ThisWorkbook
strPath = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
'Check how many files you need to open
With Sheets("Files")
lRow = Sheets("Files").Range("A" & .Rows.Count).End(xlUp).Row
End With
'open all available files
For i = 1 To lRow
Workbooks.Open (wbMaster.Sheets("Files").Range("A" & i).Value)
Next
'now run the two macros in each open file
For k = 2 To Workbooks.Count 'this will work only if your master file is the only one open when starting the sub!
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoRefresh"
DoEvents
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoPublish"
DoEvents
Next
'and close all files previously opened except for the master file
For n = Workbooks.Count To 2 Step -1
Workbooks(n).Close False
Next
End Sub

It seems like a possible explanation for what you're seeing is that your AutoPublish macro refers to ActiveWorkbook and not the safer ThisWorkbook. If another workbook is active when it's called that could lead to unexpected results.

Related

VBA: For Loop hitting Automation Error -2147221080

Here is my code.
My purpose is, open a test excel and then save as a filename contained within the 'Test' sheet. I simply want to automate the task of saving an Excel for each of a list of filenames.
Sub POPButton1_Click()
Dim i As Long, LastRow As Long
LastRow = Test.Range("A" & Rows.Count).End(xlUp).Row
Dim filename As String
filename = ThisWorkbook.Path & Application.PathSeparator & "Test.xlsx"
Dim sjk As Workbook
Set sjk = Workbooks.Open(filename)
Dim saveName As String
For i = 1 To LastRow
saveName = Test.Cells(i, "D").Value
sjk.SaveAs ThisWorkbook.Path & "\" & saveName
sjk.Close
Next i
End Sub
The first excel is saved just fine, then I hit the bug. -2147221080 Automation error.
The line of code that highlights on debug is:
sjk.SaveAs ThisWorkbook.Path & "\" & saveName
I have looked around on this site and many others, as it appears a common bug, and I get the feeling it is an easy fix, but nothing I have tried has worked. I have re-written the code many times to get it to this point - I just can't see where the error is...
Ah! I think the answer is that you close the file but then never re-open it.
Move your Set sjk = Workbooks.Open(filename) inside your For loop at the top.
That should fix it for you.

Excel 2016/2013 crashes running SaveAs method 2 times

I'd like to create several new workbooks. The VBA code below runs fine with Excel 365 and 2010. BUT with Excel 2013 or 2016, it runs fine the first time (and create the files)... and on the second run, Excel crashes without any error message.
If I run it step by step, I see that it's the SaveAs line that causes the crash.
I tried to kill the file before saving, too. To use a timer...
I tried to repair Office, to rename a HKEY (Identities), I tried to run it on 2 different windows (7 or 10). Nothing helps :/
Sub ExtraireType()
Dim shVentes As Worksheet
Dim rngVentes As Range
Dim rngTypes As Range
Dim shNew As Worksheet
Dim wkbNew As Workbook
Dim strPath As String
Dim zaza As Range
Application.DisplayAlerts = False
Set shVentes = ThisWorkbook.Worksheets("Ventes")
Set rngVentes = shVentes.Range("A1").CurrentRegion
Set rngTypes = ThisWorkbook.Worksheets("Liste").Range("A2:A4")
strPath = ThisWorkbook.Path
For Each zaza In rngTypes
rngVentes.AutoFilter
rngVentes.AutoFilter field:=3, Criteria1:=zaza.Value
rngVentes.Copy
Set shNew = ThisWorkbook.Worksheets.Add
shNew.Paste
Application.CutCopyMode = False
shNew.Move
Set wkbNew = ActiveWorkbook
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd")
wkbNew.Close
Set shNew = Nothing
Set wkbNew = Nothing
Next zaza
Set rngVentes = Nothing
Set shVentes = Nothing
Set rngTypes = Nothing
Application.DisplayAlerts = False
End Sub
This code runs well with Excel 2010 or 2019/365. But I have to use it with 2013 or 2016 :(
What am I doing wrong? Thanks for any help !
I was having this problem as well and have found a workaround - use .SaveCopyAs instead.
In the below example, .SaveAs crashes Excel every second time if I've left the Excel spreadsheet open and deleted the resultant file, whilst .SaveCopyAs saves every time irrespective. The only difference between the two is that .SaveAs has more options for how to save whereas .SaveCopyAs's only option is the filename.
Private Sub SaveAsExcelFile(TempExcelFile As Workbook, _
NewFullFileName as string, _
Optional FileFormat As XlFileFormat = xlOpenXMLWorkbook, _
Optional CreateBackup As Boolean = False)
'
' created & last edited 2020-03-06 by Timothy Daniel Cox
'
' For this example it is assumed the new file name is valid and in .xlsx format
'
Dim NewFullFileName2 as string
NewFullFileName2 = Replace(NewFullFileName, ".xlsx", "2.xlsx")
Application.EnableEvents = False
TempExcelFile.SaveCopyAs Filename:=NewFullFileName 'doesn't crash here on 2nd run
TempExcelFile.SaveAs Filename:=NewFullFileName2, FileFormat:=FileFormat, _
CreateBackup:=False 'will crash here on 2nd run
Application.EnableEvents = true
End Sub
I still think there is a bug in Excel regarding the .SaveAs however:
There's a long thread at
https://chandoo.org/forum/threads/worksheet-save-as-to-new-workbook-crashes-excel-on-second-run.40136/#post-241024
which after meandering has an apparent resolution as linked but - having
downloaded the file to see what changes have been made - he only
appears to have changed the output directory and removed a
conflicting fileformat which was set. IMO it did not resolve the
issue.
There's another similar unsolved thread at https://www.reddit.com/r/excel/comments/58fqlg/my_vba_code_works_at_first_but_if_used_twice_in_a/ which has no useful answers.
The one of the reasons that your code crash (it crushed in my case, Excel 2016), might be because you didn't add file extension at the end of:
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd")
so it might be like:
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd") & ".xlsx"
Hope it helps.

Save new file with filename cell value

I am working on making a universal production time sheet(wbTime) for each dept that will work across all shifts and lines. I have where all the necessary information is required to be entered, all the data getting copied into a table in another workbook(wbLog) and saved to be able to do analysis on the production data.
However, when it gets to trying to save the actual time sheet in the proper folder according to shift and machine line I start running into problems. I have it pulling part of the path from certain cells and the filename form the date the enter. It is getting to the last line and throwing a run-time error 1004 "Method 'SaveAs' of object_Worbook'failed".
I have only been playing with vba for 2 months so it is probably something small that I just do not see...
Sub TransferData()
If ActiveSheet.Range("E2").Value = "" Then
MsgBox "Operator Name Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("H2").Value = "" Then
MsgBox "Date Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("K2").Value = "" Then
MsgBox "Shift Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("M2").Value = "" Then
MsgBox "Line Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
Dim wbTime As Workbook
Set wbTime = ThisWorkbook
Dim wbData As Workbook
Dim LastRow As Long
Set wbTime = ActiveWorkbook
With wbTime.Sheets("Production Time Sheet")
LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
wbTime.Sheets("Production Time Sheet").Range("A6:R" & LastRow).Copy
Set wbData = Workbooks.Open("S:\Lean Carrollton Initiative\Michael\Time Sheet Data LT Test.xlsm")
Set wbData = ActiveWorkbook
wbData.Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbData.Close SaveChanges:=True
Dim Fname As String
Dim Path As String
Dim shft As String
Dim Line As String
Set wbTime = ActiveWorkbook
Fname = Sheets("Production Time Sheet").Range("I2").Text
shft = Sheets("Production Time Sheet").Range("Z9").Text
Line = Sheets("Production Time Sheet").Range("AC11").Text
Path = "K:\Groups\OFS Time Sheets\8hr Production Schedule\LT Jacketing\" & shft & Line & Fname & ".xlsx"
ActiveWorkbook.SaveAs filename:=Path, FileFormat:=xlNormal
End Sub
You are using as name of file the text 2/5/2019.xlsx. As far as I know, the simbol / cannot be used in Windows to name a file.
Try with a different name for file. Something like:
Fname = Replace(Sheets("Production Time Sheet").Range("I2").Text,"/","-")
a) Don't use Range.Text, use Range.Value2.
Text will give you exactly what is written in the cell, and if the cell diplays ###because your cell is to narrow to display a number, it will give you ###.
b) Put a statement Debug.print path before the SaveAs and check in the immediate window (Ctrl+G) if the path is exactly what you expect.
c) Be sure that when you issue the SaveAs-command, the same file is not already open in Excel - this happens often when you test your code repeatedly (it may still open from the last test). SaveAs saves a copy of the file and keeps it open!
d) Use FileFormat:=xlOpenXMLWorkbook when you name the file with extension xlsx. xlNormal will save the file with the old Excel file format and expects xls as extension.
e) Try to save the file with exactly the name from the Excel SaveAs dialog to see if the filename is okay and you have permission to save a file.

Workbooks.open hangs

I have a macro that will open another workbook from a network location, compare some values in a range, copy/paste any that are different, and then close the file. I use variables to open the file, because the appropriate filename is based on the current date. I also set Application.ScreenUpdating = False, and Application.EnableEvents = False
for some reason, the code has begun to hang on the worksheets.open line and I can't even CTRL+Break to get out of it. I have to manually close Excel and sometimes it give me an error message, complaining about there not being "enough memory to complete this action".
I can put a stop in the code and confirmed the variables are supplying the correct string, which equates to:
"\Clarkbg01\public\PRODUCTION MEETING\PROD MEETING 3-21-18.xlsm"
I can paste this into Windows Explorer and it will open right up with no issues. I can manually select the file from Explorer and it will open with no issues. I can paste the following line into the immediate window and it will hang...
workbooks.Open("\\Clarkbg01\public\PRODUCTION MEETING\PROD MEETING 3-21-18.xlsm")
This happens even if I open a blank sheet and execute that line from the immediate window.
from my macro, stepping through the code goes without a hitch. I can verify all the variables are correct, but when it steps across workbooks.open, it hangs.
I have other macros that open workbooks, do much more complicated routines, then close them with zero issues, but I'm really stuck on why this one is giving me so many problems.
Any ideas?
Here is the code:
'This will open the most recent meeting file and copy over the latest for jobs flagged with offsets
Dim Path As String
Path = ThisWorkbook.Path
'Debug.Print Path
Dim FileDate As String
FileDate = ThisWorkbook.Sheets("MEETING").Range("3:3").Find("PREVIOUS NOTES").Offset(-1, 0).Text
'Debug.Print FileDate
Dim FileName As String
FileName = "PROD MEETING " & FileDate & ".xlsm"
Debug.Print "Looking up Offsets from: " & FileName
Dim TargetFile As String
TargetFile = Path & "\" & FileName
Debug.Print TargetFile
Application.ScreenUpdating = False
Application.EnableEvents = False
'The old way I was opening it...
'Workbooks.Open FileName:=Path & "\" & FileName, UpdateLinks:=False ', ReadOnly:=True
'The most recent way to open
Dim wb As Workbook
Set wb = Workbooks.Open(TargetFile, UpdateLinks:=False, ReadOnly:=True)
'Do Stuff
wb.Close savechanges:=False
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Offsets should now reflect settings made in meeting on " & FileDate
End Sub
If the workbook you're opening contains code in the Workbook_Open event then this will attempt to execute when the event fires .
To stop this behaviour use the Application.AutomationSecurity Property.
Public Sub Test()
Dim OriginalSecuritySetting As MsoAutomationSecurity
OriginalSecuritySetting = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable
'Open other workbook
Application.AutomationSecurity = OriginalSecuritySetting
End Sub

Excel Removed Attachments when trying to Dynamically Create a new Module

I have this little VBA module that I call from one workbook to update all Excel Workbooks in a given folder. By update I mean it copies a module called GetActiveXControlValues and then runs this macro on each workbook in that folder. Now when I run this on my machine everything works fine. When my co-worker runs this same code with the same files, they gets a surprise after copying the module. When you go to look at the workbook that should have the new module called 'GetActiveXControlValues', instead there is no module by that name, instead it is called 'Module1'. In addition, when you look inside the new module it says 'Attachment has been removed' in red. I checked and my co-worker has the exact same Security Settings in Excel 2010 as I have.
I have enable all Macros and Trust VBA Project Object Model. I have Prompt me for enabling all ActiveX controls. I have Disable Trusted Documents unchecked and all the boxes on the Protected View tab. Anyone seen this before or have an idea what I can try to troubleshoot?
Sample Code:
Sub CopyModuleAndExecuteIt()
Dim wb As Workbook
Dim sFile As String
Dim sPath As String
Dim sFullMacroName As String
SetFolder
sPath = sExcelFolder
ChDir sPath
sFile = Dir("*.xls") ' File Naming Convention
Do While sFile <> "" ' Start of LOOP
' Open each Excel File in the specified folder
Set wb = Workbooks.Open(sPath & "\" & sFile) ' SET BP HERE!
Sleep (1000)
' Unprotect the Documents using SendKeys Hack
UnprotectVBADocument
' Import the GetActiveXControlValues Module into the Workbook
wb.VBProject.VBComponents.Import ("D:\GetActiveXControlValues.bas") ' SET BP HERE!
sFullMacroName = "'" & wb.Name & "'" & "!" & wb.VBProject.VBComponents.Item("GetActiveXControlValues").Name & ".GetActiveXControlValues"
' Run the GetActiveXControlValues Macro
Application.Run (sFullMacroName)
' Close the Workbook Saving Changes
wb.Close True
sFile = Dir
Loop ' End of LOOP
End Sub
If your co-worker has the exact same Security Settings in Excel 2010 as you have then the next thing that comes to my mind is the "Firewall". Check his firewall settings.
I was working to create an AddIn trough VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Attribute VB_Name = "Module_Name"
And you have to be sure that you .bas file is actualy is plain text.
I was working to create an AddIn with VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Sub Superheroes()
Dim sBeg as string, sEnd as String, sCatwoman as String, sAntMan as String
Dim vCode As Variant
'' Here is where i put the name i want to call my module
sBeg = "Attribute VB_Name = ""VBA_BasFile""" + vbCrLf + _
"Private Function fMix(sAnimal as String)as String "
sCatwoman = "Select case sAnimal"+ vbCrLf+ vbTab+"case ""cat"""+ _
vbCrLf+ vbTab+ "fMix = ""Catwoman"""
sAntMan = vbCrLf+ vbTab+"case ""Ant"""+ vbCrLf+ vbTab+ "fMix = ""AntMan"""+ _
vbCrLf+ "End Select"
sEnd = vbCrLf+ "End Sub"
vCode = Array(sBeg, sCatwoman, sAntMan, sEnd)
Workbooks.add
Range("A1").Resize(UBound(vCode) + 1, 1) = Application.Transpose(vCode)
With ActiveWorkbook
.SaveAs path + "VBA_BasFile.bas", xlTextPrinter
.Close False
End With
End Sub
With this i can Call any procedure or function in the VBA_BasFile when i importe to another Excel Workbook.

Resources