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.
Related
I've been running into issues for a while with trying to save Excel files in new folders. I think that it's connected to OneDrive folders trying to sync, but I can't find anything that helps confirm this issue. I've included a sample piece of code that replicates the issue I've had. If I run this once (creating a new folder), then I will get a SaveAs error. But if I immediately run it again, it will just ask to overwrite the file and it will save just fine. Is there a way to go about handling the save as error or to continue to try until it's saved successfully?
Sub save_file()
Dim folder_path As String
folder_path = "C:\Users\" & Environ("USERNAME") & "\OneDrive - Company Name\Desktop\Test Folder"
If Len(Dir(folder_path, vbDirectory)) = 0 Then
MkDir (folder_path)
End If
Dim new_book As Workbook
Set new_book = Workbooks.Add
new_book.SaveAs Filename:=folder_path & "\Test Book", FileFormat:=51
End Sub
EDIT: I was able to find a potential workaround, although I haven't done much yet to test it. This file is still being saved to the folder, so I can close the file that gives the save error, and then just reopen it (here also setting it as the same Workbook object for reuse.
Sub save_file()
Dim folder_path As String
folder_path = "C:\Users\" & Environ("USERNAME") & "\OneDrive - Company Name\Desktop\Test Folder " & Format(Now, "HHMMSS")
If Len(Dir(folder_path, vbDirectory)) = 0 Then
MkDir (folder_path)
End If
Dim new_book As Workbook
Set new_book = Workbooks.Add
book_name = folder_path & "\Test Book " & Format(Now, "HHMMSS")
On Error GoTo savehandler
new_book.SaveAs Filename:=book_name, FileFormat:=51
Exit Sub
savehandler:
new_book.Close
Set new_book = Workbooks.Open(book_name)
End Sub
I have spent my whole morning on this and cannot get it working properly. A simple Excel userform was created asking for a filename. If the file exists in the directory I want it to open. If it does not exist I want a "template" file opened instead. I have the does not exist working properly, however cannot get the "does exist" part working. Please help.
Private Sub CmdEnter_Click()
Dim Path As String
Dim File As String
Path = Range("Search!B1")
File = TxtOrder.Value
'If File exists then open.
If Dir(Path & File & ".xlsm") = Path & File & ".xlsm" Then
Workbooks.Open FileName:=Path & File & ".xlsm"
'If File does not exist then open.
ElseIf Dir(Path & File & ".xlsm") = Error Then
Workbooks.Open FileName:=Path & "QCSFormTrial.xlsm"
End If
'Close Dialog and Close Workbook
Workbooks("QCSLaunch.XLSM").Close SaveChanges:=False
End Sub
Please, try this way:
Private Sub CmdEnter_Click()
Dim Path As String, File As String, wb As Workbook
Path = Range("Search!B1")
File = TxtOrder.value
'If File exists then open.
If dir(Path & File & ".xlsm") <> "" Then
Set wb = Workbooks.Open(Path & File & ".xlsm")
Else 'else, open the other one:
Set wb = Workbooks.Open(Path & "QCSFormTrial.xlsm")
End If
Stop 'check if the workbook has been open and press F5 to let code finishing
wb.Close SaveChanges:=False
End Sub
The issue is that Dir(Path & File & ".xlsm") = Path & File & ".xlsm" is basically saying does the folder path I named equal the folder path I named. The path isn't actually directed at the actual folder in way that will open it.
Try this: https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/
Sub LoopAllFilesInAFolder()
'Loop through all files in a folder
Dim fileName As Variant
fileName = Dir("C:\Users\marks\Documents\")
While fileName <> ""
'Insert the actions to be performed on each file
'This example will print the file name to the immediate window
Debug.Print fileName
'Set the fileName to the next file
fileName = Dir
Wend
End Sub
Or, you can remove the If Then and directly open the file. If the file exists, it will open, if not, it will error. You can use error handling then continue.
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 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
I am trying to write a loop that copies and pastes a range of data from one workbook to another. I get stuck with the error 'Select Sheet method not proper' or whatever the error message is. This is what I have so far:
folderpath="insert folder path here"
Filename = Dir(folderPath)
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename)
wb.Worksheets("Outcomes & Factors Rankings").Select
Range("A3", Range("A3").End(xlDown).Offset(0, 6)).Copy
ThisWorkbook.Worksheets("OutcomeFactorRankings").Select
Range("A1").End(xlDown).Offset(1, 0).Select.Paste
wb.Close
Loop
Try to indent your code, you don't need all those selects in your code, simplify, something like that should solve your problem:
folderPath = "insert folder path here"
Filename = Dir(folderPath)
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename)
wb.Worksheets("Outcomes & Factors Rankings").Range("A3", Range("A3").End(xlDown).Offset(0, 6)).Copy
ThisWorkbook.Worksheets("OutcomeFactorRankings").Range("A1").End(xlDown).Offset(1, 0).Paste
wb.Close
Loop