VBA Code showing error with older files "xslx" issue? - excel

I still seemed to be having issue with a code I am using to transfer multiple workbooks into 1 workbook. This code has worked to transfer 500 files into respective workbooks.
I have followed the exact same process for older files, but this is still throwing the same issue it was before. When I started this project, I tried to do it with the older workbooks in the file, and this happened but it worked perfectly with newer ones. Here is the code I am using for the older files, which is exactly the same except the file path is different to reference the files to be transferred. All of the files in the folder are `.xslx' I have checked this by selecting that the file extension be shown. I am totally beside myself as to why this is not working. When I run this code now it transfers the first 8 workbooks then gives me an error? Any ideas please?
Working VBA:
Sub TransferToMaster()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\Users\james\OneDrive\Desktop\Invoices Jones UK Group\Paid\JJ0500-JJ0599" 'Change as needed
FileName = Dir(Path & "\*.xlsx", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The only thing I am changing in this code is "C:\Users\james\OneDrive\Desktop\Invoices Jones UK Group\Paid\JJ0300-JJ0399"
I have tried several variations of this line FileName = Dir(Path & "".xlsx", vbNormal), from "".xls*", and "".xl". I have also done lots of research on this forum to try to resolve the problem if it is the file extensions. But I don't get why it loads up the 8 sheets and stops. When its been working perfectly? I will upload a screenshot of my code.

Related

Excel VBA won't save: creating 8-digit alphanumeric "filename"

I am new to VBA. I am using a "shell" macro to run another macro on a series of files. It won't save. I am going to include my code here and also a series of photos because the photos were the only way to show the result of hovering over the values in the code.
So, the error message is generating something I don't understand. But it is clear that the links in the code link to what the results should be, so I'm confused.
This is the code:
Sub SHELLforMacros()
Dim wbMatrix As Workbook
Dim strFileName As String
Dim strFileName As String
Dim newFileName As String
Dim strPath As String
Dim strExt As String
Dim objWorkbook As Workbook
Dim ws As Worksheet
Dim Sheetname As Worksheet
Set Sheetname = Worksheets(1)
Dim Worksheet As Worksheet
Dim rng As Range
Set rng = Range("A2")
strPath = "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\test\"
strExt = "csv"
strFileName = Dir(strPath & "*." & strExt)
While strFileName <> ""
Set wbMatrix = Workbooks.Open(strPath & strFileName)
Application.Run "'C:\Users\myname\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB'!Graph_NEW"
strPath = "C:\Users\myname\All_mricgcm3_files\45\Fall45\test\"
newFileName = Sheetname.Range("A2").Value
ActiveWorkbook.SaveAs fileName:=strPath & newFileName, FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
Wend
End Sub
What this macro is supposed to do is open a file, run another macro on the file (creating a graph), and then save the file with the same name but as an .xlsx file. Then open the next file in the folder and do the same, until it runs out of files. I realize the code may not be the most current. It is cobbled together from things I've found online. Thanks for any help.
Edit: UPDATE - I removed all the section on saving and closing the file from the "shell" macro and put it into the "Graph_NEW" macro. Now the "shell" macro is running fine. But I am running into the same issue with the "Graph_NEW" macro now. It is exactly the same error message as highlighted in the first image, only each time there is a new 8-digit alphanumeric "filename" that it is looking for. This seems like a very specific thing.
I changed the section in the following ways, successively, in an attempt to debug. I added With and End With around the section:
With WB
ActiveWorkbook.Save
newFileName = Sheetname.Range("A2").Value
strPath = "C:\Users\qmontana\All_mricgcm3_files\mric45\Fall45\test\"
ActiveWorkbook.SaveAs fileName:=strPath & newFileName & ".xlsx", FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
End With
I changed the name of the folder from "45" to "mric45" thinking that maybe it didn't like a number as a folder name.
I removed the "backslash" at the end of the strPath--and then the 8-digit alphanumeric string showed up as an error after the Fall45 folder, like this "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\777GTY78". Yet, as I've shown in the images, all indications are that it knows what file it is working with. There are no "blank spaces" in the pathname.
I tried taking the underscores out of the folder "All_mricgcm3_files".
I moved the line newFileName = Sheetname.Range("A2").Value to come before the strPath line.
Where is this 8-digit alphanumeric "filename" coming from?? (See error code, first image.)
Ok, it was a very simple thing, in case anyone else runs into this problem.
Took me two days to find out though --> I had somehow dropped a folder layer in the path name. The catch? The alphanumeric string was showing up at the end of the path name, not where the folder layer was missing. That's why I was thrown off because my focus was on the ending.
When I added that folder\ back in, I had no more problem with saving and the macro ran fine.

VBA Script runs in Excel but not CMD/Powershell

I have a VBA script in Excel which works fine but when saved as script_name.vbs and executed in cmd/powershell as cscript.exe script_name.vbs it throws the error:
dir_path\script_name.vbs(30, 37) Microsoft VBScript compilation error: Expected ')'
Firstly I apologise. This seems like a well-worn question but no answer I could find explains any reasons why my particular VBA script won't work.
I learnt that you cannot Dim As when running vbs on the cmd line so I removed that, and then got the above error. No question I found seems to indicate to me as to why.
Help much appreciated!
Thanks
FYI: The macro is to iterate through all files which have passwords in a folder and
Attempt a number of any possible passwords to open the file
Same again for workbook protection passwords
Unhide all worksheets
Save the file
Move onto the next file
Sub BAUProcessVBA()
Dim wb
Dim ws
Dim myPath
Dim myFile
Dim myExtension
Dim i
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
myPath = "C:\blah\dir\"
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Debug.Print myFile
On Error Resume Next
Set wb = Workbooks.Open(Filename:=myPath & myFile, Password:="pw1", IgnoreReadOnlyRecommended:=True, ReadOnly:=False)
Set wb = Workbooks.Open(Filename:=myPath & myFile, Password:="pw2", IgnoreReadOnlyRecommended:=True, ReadOnly:=False)
On Error GoTo 0
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Remove workbook protection and, unhide all tabs, save the file
On Error Resume Next
wb.Unprotect "pw1"
wb.Unprotect "pw2"
On Error GoTo 0
On Error Resume Next
wb.Password = ""
On Error GoTo 0
For Each ws In wb.Worksheets
ws.Visible = xlSheetVisible
Next ws
'Save and Close Workbook
Application.CutCopyMode = False
wb.Close SaveChanges:=True
Application.EnableEvents = False
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
You seem under the impression that Visual Basic for Applications vba and Visual Basic Script vbscript are identical languages. That is not the case. They may be more closely related than Visual Basic .Net vb.net and VBA or VBS, but they are still different languages.
Which is why we have different tags for all of them.
Now, to tackle your question:
VBA has got the Microsoft Office Object Library reference, which means native support for office objects.
Application doesn't exist in vbs, so you need to create that object: Set Application = WScript.CreateObject("Excel.Application")
Excel constants don't exist:
xlCalculationManual = -4135, xlCalculationAutomatic = -4105 and xlSheetVisible = -1
Dir doesn't exist, so you need to create a FileSystemObject
Named arguments don't exist, so you need commas:
Set wb = app.Workbooks.Open(myPath & myFile, , False, , "pw1", , True)
And DoEvents doesn't exist either.
To solve this problem I have used Python to open Excel and execute the Macro I want. Below is a function that should work for anyone.
Things I have learnt: If you have VBA code in Excel and want to run it without Excel then you cannot just save this as a .vbs and execute it on the command line with cscript.exe.
VBS and VBA are different languages.
Therefore, a quick tutorial for those stuck at the same problem but are unfamiliar with Python:
Download and install Python ensuring python is added to PATH. This script was written and successfully executed with Python 3.8 64-bit for Windows. https://www.python.org/downloads/
Save the below in a file called run_macro.py
On the last line of run_macro.py, with no indentation, type what is below within Code2
Carrying on with Code2: Inside of the quotes 'like this' type in what it's asking for. The filepath_incl_filename must contain the full path AND the filename whereas filename must contain ONLY the filename. Yes, it must be provided like this.
Copy the filepath where run_macro.py is located and press win+r and type 'cmd' to open the cmd terminal, then type cd <filepath from clipboard> and press enter
Now type python run_macro.py
So long as you get no errors and it appears to "freeze" then that means it's working. Otherwise, you will need to debug the errors.
Code:
import win32com.client as wincl
def run_excel_macro(filepath_incl_filename=r'raw_filepath', filename='', module_name='', macro_name=''):
"""
:param filepath_incl_filename: Must be r'' filepath to dir with filename but also include the filename in the filepath (c:\etc\folder\wb_with_macro.xlsm)
:param filename: Filename of xlsm with the Macro (wb_with_macro.xlsm)
:param module_name: Found inside 'Modules' of macros within that workbook
:param macro_name: The 'sub name_here()' means macro is called 'name_here'
:return: Nothing. Executes the Macro.
"""
# script taken from: https://stackoverflow.com/questions/19616205/running-an-excel-macro-via-python
# DispatchEx is required in the newest versions of Python.
excel_macro = wincl.DispatchEx("Excel.application")
workbook = excel_macro.Workbooks.Open(Filename=filepath_incl_filename, ReadOnly=1)
excel_macro.Application.Run(f"{filename}!{module_name}.{macro_name}")
# Save the results in case you have generated data
workbook.Save()
excel_macro.Application.Quit()
del excel_macro
Code2
run_excel_macro(
filepath_incl_filename=r'',
filename='',
module_name='',
macro_name=''
)

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 rebooting while copying sheets from multiple books

I built a program to copy sheet one from all books in a directory, and paste them into the active workbook. I have roughly 1200 books in the directory, and without fail each time I run it excel reboots after around #125. No error messages. Anyway of getting around this?
Sub GetSheets()
Path = "C:\Users\bdaly\Desktop\Formulas\smaller sample\"
Dim DestWB As Workbook
Set DestWB = ThisWorkbook
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
Sheets("Sheet1").Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
Application.DisplayAlerts = False
Workbooks(Filename).Close
Application.DisplayAlerts = True
Filename = Left(Left(Filename, Len(Filename) - 4), 31)
DestWB.Sheets(DestWB.Sheets.Count).Name = Filename
Filename = Dir()
Loop
End Sub
Edit: As advised I removed the offending file, Excel still reboots after 124 loops.
Not sure if this is going to address the problem at hand, but it will help in debugging or exposing the problem.
Put simply, qualify your source data.
Include Dim SourceWB as Workbook. This could be done where you declare DestWB.
Change Workbooks.Open Filename:=Path & Filename, ReadOnly:=True to Set SourceWB = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True, Editable:=True)
Change Sheets("Sheet1").Copy After:=DestWB.Sheets(DestWB.Sheets.Count) to SourceWB.Sheets("Sheet1").Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
Change Workbooks(Filename).Close to SourceWB.Close
Unfortunately, the .Copy command is a Sub, not a Function - would be so much more neater if it provided a reference to the sheet that has just been created as you could then use it in DestWB.Sheets(DestWB.Sheets.Count).Name = Filename
I suggest, for debugging purposes, keeping the DisplayAlerts on for now. This may provide a clue as to where the fault is happening.
Also include some debug.print lines in your loop. Finding where in the loop it crashes could help diagnose the issue. Make them a little descriptive, the ones I would think of are:
debug.print "Entered loop"
debug.print "Copied file"
debug.print "renamed file"
'debug.print "new FileName is " & FileName`.
You get the idea.
Try the AddIn from the link below.
https://www.rondebruin.nl/win/addins/rdbmerge.htm

VBA Code to Convert CSV to XLS

Objective: I have a folder where multiple CSVs are dumped on my drive. These CSVs need to be converted to XLS files and saved (as XLS files) into the same, original folder. I have a code (pasted below) for it that works just fine, but...
Problem: A window pops up each time saying "Code execution has been interrupted," allowing me to Continue, End, or Debug. I can click Continue each time the window pops up (it pops up for each file that needs to be converted) and the script will work perfectly, but of course, I'd rather not have to click Continue potentially hundreds of times. The asterisk'd part of the code below is the part that is highlighted upon clicking Debug.
Sub Convert_CSV_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "xx:\xx\xx\xx\xx\xx\xx\xx\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & "\" & strFile, Local:=True)
**wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 56**
wb.Close SaveChanges:=False
Set wb = Nothing
strFile = Dir
Loop
End Sub
Again - the code DOES work, it's just that the Debug window keeps popping up and I can't figure out what the issue is. By the way, I had to "xx" out the actual directory.
Thank you for any help!
Try : this
It may help solving your problem, I had one of those sticky debug boxes too for no reason at all and this line helped me.
Edit: Here's the code from the website above which solves the problem described.
Adding this line in the beggining of one's code will do the trick.
Application.EnableCancelKey = xlDisabled

Resources