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
Related
To get to the point of completion for my macro, I start with a downloaded file from the internet which downloads as .xls. After downloading it, I then need to save the file as a .xlsx and change the name of the document to be "dockactivity".
This is a macro that multiple people on multiple devices would be using so I need to keep Environ$("username") parts. (Unless that written wrong of course..)
This is a macro I use everyday for my job so I wanted to try and have it delete the original downloaded as well.
The problem I am running into:
It seems to get stuck in an endless loop of saving the file, closing it, opening it, etc.
Here is what I have in now (everything that is before the more cosmetic changes are done to the file). Please note that I am quite a novice at this type of stuff and have pieced together this code from multiple sources online/this site.
Sub dockactivity()
'
' dockactivity Macro
'
' push button to run
'
Dim Filename, Pathname, SaveFileName As String
Dim wb As Workbook
Dim UserName As String
UserName = Environ("username")
Pathname = "C:\Users\" & Environ$("username") & "\Downloads\"
Filename = Dir(Pathname & "Dock_Activity_*.xls")
Application.DisplayAlerts = False
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.CheckCompatibility = True
Application.DisplayAlerts = False
wb.SaveAs Filename:="dockactivity", FileFormat:=xlOpenXMLWorkbook
wb.Close SaveChanges:=False
Filename = Dir(Pathname & "Dock_Activity_*.xls")
Loop
Application.DisplayAlerts = True
If Dir(Pathname & "Dock_Activity_*.xls") <> "" Then
Kill (Pathname & "Dock_Activity_*.xls")
End If
Workbooks.Open (Pathname & "dockactivity.xlsx")
Windows("dockactivity.xlsx").Activate
Thanks for any help provided.
Background Information - I have two buttons, that both run a set of code. The excel file has over 30 columns and 65,000 rows. This file is exported (.csv) from somewhere and is updated biweekly.
Goal - have the new file saved with the same name as the old. So that the values can be updated, buttons are still available and the code can run again with the new file.
Or That when a new file is exported, it is saved in a folder that runs the code INDEPENDENT of the user path. i.e Pathname = ActiveWorkbook.Path & "C:\Users\"this can be any name"\Desktop\Downloads\"
Attempt
Used a similar code to the one in a previous question "Run same excel macro on multiple excel files" with edits to tailor for my code. With no success
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
Currently, when I attempt the first method I only replace (Old file + VBA) with (New file).
Please note that the solution does not need to be a VBA code. If it's just saving the file in a new method that stores the macro and updates the values I would be happy.
An example of my previous answer:
Sub SaveThisAs()
Dim wb As Workbook: Set wb = ThisWorkbook 'ThisWorkbook referrs to the workbook the macro is ran from
Dim PathToSaveTo As String
PathToSaveTo = wb.Path & "\"
PathToSaveTo = PathToSaveTo & Format(Now, "ddMMyyyy_hhmmss") & wb.Name 'Lets add a timestamp
'Do your macro stuff here
'....
'Save the workbook
wb.SaveAs PathToSaveTo
End Sub
Please note that I'm using wb.Name at the end of the file to save to... this will be fine first time you run this, but a second time the name will get longer... and longer ... and longer. Adjust as per your needs with an appropriate file name.
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
I am quite new to excel VBA macros so my problem should be easily solved.
I am trying to open all files in one folder, edit those files a little bit and copy them to existing workbook. Unfortunately, run-time error '424': Object required, occurs.
Highlighted is row:
ActiveSheets.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
It looks like "Macro sheets.xlsm", does not exists, but that is the name of workbook, from which I run this macro.
I have went through many forums, tried a lot of codes, but still did not find the solution.
Please, can somebody help me?
Thank you a lot,
Jan
Sub nahranidat()
Dim YourFile As Variant
Dim YourFolderPath As Variant
YourFolderPath = "K:\MMR\2015\BO\macro files connection\"
ChDir YourFolderPath
YourFile = Dir(YourFolderPath & "*.*")
Do While YourFile <> ""
Workbooks.Open Filename:=YourFolderPath & YourFile
YourFile = Dir
Set myObject = ActiveWindow
If Activeworkbook.Worksheets.Count = 2 Then
Sheets(1).Select
ActiveSheet.Name = Left(Activeworkbook.Name, InStr(Activeworkbook.Name, ".") - 1) & "_1_month"
Sheets(2).Select
ActiveSheet.Name = Left(Activeworkbook.Name, InStr(Activeworkbook.Name, ".") - 1) & "_by_month"
Activeworkbook.Sheets.Select
ActiveSheets.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
Else
Sheets(1).Select
ActiveSheet.Name = Left(Activeworkbook.Name, InStr(Activeworkbook.Name, ".") - 1)
Activeworkbook.Sheets.Select
ActiveSheets.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
End If
Application.CutCopyMode = False
myObject.Close , SaveChanges:=False
Loop
End Sub
You've referenced ActiveSheets instead of ActiveSheet so VBA will assume you have created a new object. Just change that line to
ActiveSheet.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
It is good practice to declare Option Explicit at the top of each module, that way a 'variable not defined' error makes it easier to spot typographical errors in variable/object names. You can set this automatically by going to VBA>Tools>Options>Editor>Require Variable Declaration.
In this section of code, Excel ALWAYS prompts: "File already exists, do you want to overwrite?"
Application.DisplayAlerts = False
Set xls = CreateObject("Excel.Application")
Set wb = xls.Workbooks.Add
fullFilePath = importFolderPath & "\" & "A.xlsx"
wb.SaveAs fullFilePath, AccessMode:=xlExclusive, ConflictResolution:=True
wb.Close(True)
Why does db.SaveAs always prompt me to overwrite existing file if I have DisplayAlerts = False?
To hide the prompt set xls.DisplayAlerts = False
ConflictResolution is not a true or false property, it should be xlLocalSessionChanges
Note that this has nothing to do with displaying the Overwrite prompt though!
Set xls = CreateObject("Excel.Application")
xls.DisplayAlerts = False
Set wb = xls.Workbooks.Add
fullFilePath = importFolderPath & "\" & "A.xlsx"
wb.SaveAs fullFilePath, AccessMode:=xlExclusive,ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
wb.Close (True)
I recommend that before executing SaveAs, delete the file if it exists.
If Dir("f:ull\path\with\filename.xls") <> "" Then
Kill "f:ull\path\with\filename.xls"
End If
It's easier than setting DisplayAlerts off and on, plus if DisplayAlerts remains off due to code crash, it can cause problems if you work with Excel in the same session.
To split the difference of opinion
I prefer:
xls.DisplayAlerts = False
wb.SaveAs fullFilePath, AccessMode:=xlExclusive, ConflictResolution:=xlLocalSessionChanges
xls.DisplayAlerts = True
Finally got it right, everything above is so confusing.
Sub SaveAndClose()
Dim wb1 As String
Application.Calculation = xlCalculationAutomatic
'this only works if the following equation is in C43 in sheet "data"
'=LEFT(MID(CELL("filename",C41),SEARCH("[",CELL("filename",C41))+1, SEARCH("]",CELL("filename",C41))-SEARCH("[",CELL("filename",C41))-1),75)
'the vba equation has double quotes everywhere that is how you use a formula in vba.
'vba code recreates this incase it gets deleted by accident.
ThisWorkbook.Sheets("Data").Range("C43").ClearContents
ThisWorkbook.Sheets("Data").Range("C43").Formula2R1C1 = _
"=LEFT(MID(CELL(""filename"",R[-2]C),SEARCH(""["",CELL(""filename"",R[-2]C))+1, SEARCH(""]"",CELL(""filename"",R[-2]C))-SEARCH(""["",CELL(""filename"",R[-2]C))-1),75)"
'https://techcommunity.microsoft.com/t5/excel/cell-reference-containing-file-name-changes-when-opening-second/m-p/2417030
wb1 = ThisWorkbook.Sheets("Data").Range("C43").Text
If ThisWorkbook.Name = wb1 Then
'MsgBox (wb1)
Workbooks(wb1).Close SaveChanges:=True
End If
End Sub
this will allow the spreadsheet to determine its own name and then only then can the sub run something against that name. this is so when you have multiple sheets running duplicate sheets but with different names you don't accidently close the wrong sheet. this is a huge win for CYA in my book.
This will also bypass the overwrite message too, you can have the code automatically run in the background on another workbook while you are working in a different workbook without being affected.