I have recently encountered a problem where a macro that used to work in previous versions of Excel has stopped functioning as intended. The macro, when functional, opens each file in a specific folder and copies some of its data and pastes it into another file which it opened.
Since this macro is run from within a file in the folder, it was previously programmed to not attempt to re-open the file, using the code below:
' Create a new workbook and set a variable to the first sheet.
' Set SummarySheet =
Workbooks.Open ("[Redacted]")
' agg_wkb_name = ActiveWorkbook
lrowcount = ActiveWorkbook.Worksheets("scheduled hours").UsedRange.Rows.Count
ActiveWorkbook.Worksheets("scheduled hours").Range("A2:bz" & lrowcount).Delete
' Modify this folder path to point to the files you want to use.
FolderPath = "[Redacted]"
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 2
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
If FolderPath & FileName = ThisWorkbook.FullName Then
Set WorkBk = ThisWorkbook
Else
Set WorkBk = Workbooks.Open(FolderPath & FileName, , True)
End If
However, after our computers and programs were updated to Win10 and Excel 2016, this macro began attempting to also open the workbook running the file ('ThisWorkbook'). When you attempt to say "no, I don't want to re-open the file", it stops the Macro, and when you say "yes", Excel crashes.
I attempted to segregate the code, to pull the data from 'ThisWorkbook' differently than pulling it from the various other workbooks in the folder. The new section of code reads:
Do While FileName <> ""
If Not (FolderPath & FileName = ThisWorkbook.Path & ThisWorkbook.Name) Then
Set WorkBk = Workbooks.Open(FolderPath & FileName, , True)
End If
Unfortunately, the very same error still occurs. I'm at a loss - my best guess is that something changed in the way 'ThisWorkbook' functions between the last version of Excel and the current one.
So, it turns out that a system administrator had re-mapped the folder to a drive on my computer. I fixed it by not having the code look at the file location for comparison, only the name, since that's all that changes once you get into the folder.
If anyone ever runs into this, or has a similar situation where they are opening all files in a folder except the one that is currently open - don't bother with the filepath. Just use the name.
Related
I have an old 2003 xls macro that extracts data from all excel dump files in an "inbox" type subfolder. The files are generated daily and as far as I can tell from this old code, the Application.Find looks up all files it can find in this inbox and then goes through them one by one to sort the data and place it properly in the main document.
The problem of course is that Application.Find is used and does not exist in Excel anymore, requiring the use of the old Excel version to execute this macro. It's a pain to have to run an old version for the import of data and then a new version for all the other needs so I was hoping I could get some help to replace this old code with a new function that serves the same role.
I've looked around here and other places for peoples functions to find x amount of files in a given location and go through them one by one but I am not all that good at trying to integrate these more modern solutions with this older macro as it already has a structure in place to loop until all the Application.Find results have been completed.
I tried a Dir approach but was unsuccessful and I can't manage to get a filecount/array thing going so it can just work through whatever it finds in that subfolder.
With Application.FileSearch
.NewSearch
.LookIn = inbox
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
The expected result is that this can loop harmlessly when executed since further down in the code after having gone through the data in the opened document, it will ask for the Next i and keep going until running out of files. However, as Application.Find no longer exists, it just stops at that point with the expected error message unless I run the 2003 version.
Any help at all would be really appreciated!
This is how I loop through all the files in a folder:
Option Explicit
Sub Test()
Dim FilePath As String, FileName As String
Dim wb As Workbook
FilePath = "Your Path"
FileName = Dir(FilePath & "*.xls*")
Do While FileName <> ""
Set wb = Workbooks.Open(FilePath & FileName, UpdateLinks:=False, ReadOnly:=True)
'Your Code
FileName = Dir
Loop
End Sub
In this case, as you can see, looking for any file which extension containts xls so... xls, xlsx, xlsm, xlsb...
Hope it helps
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 number of corrupted .xlsx files in a directory.
I want to open every single file for repair and save it with the same name via VBA script.
I`ve tried following piece of code to solve this problem:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\output\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename, CorruptLoad:=xlRepairFile)
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
But this code only repairs first file and opens windows explorer to save file manualy.
Is there a way to perform repair and save all files with the same name in the same folder automatically?
I haven't touched VBA in years, but there is an explicit wb.SaveAs method you can call.
Have you set Application.DisplayAlert = False? Your codes seems fine. You just have to turn it on later.
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
Very new to this so please help. Im trying to mass update files in a static folder location, many files in one folder.
What i want to do is
run VBA macro in Excel 2010 to goto a network location folder,
open the first file in the folder.
Unprotect the workbook and worksheets call another marco to run changes
then protect the worksheet close the file
and then move onto the next file in the folder until all files have been corrected.
I have created the marco to make the changes, this is called "Edit"
File types are xlsm and the workbook and worksheet are password protected How can i automatically run the macro to goto the network location and in series open each file, unprotect, call the macro, then re protect the document close file and move onto the next file until they are all updated.
Sub Auto_open_change()
Dim WrkBook As Workbook
Dim StrFileName As String
Dim FileLocnStr As String
Dim LAARNmeWrkbk As String
PERNmeWrkbk = ThisWorkbook.Name
StrFileName = "*.xlsx"
FileLocnStr = ThisWorkbook.Path
Workbooks.Open (FileLocnStr & "\" & StrFileName)
Workbooks(StrFileName).Activate
With Application.FindFile
SearchSubFolders = False
LookIn = "Network location"
Filename = "*.xlsm"
If .Execute > 0 Then
Debug.Print "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
WrkBook.Worksheets(1).Select
ThisWorkbook.Worksheets(1).Cells(DestinationRange) = WrkBook.Worksheets(1).Cells(SourceRange).Value
Next i
Else
Debug.Print "There were no files found."
End If
Im managing to unprotect the file update and reprotect the file fine, just cant get the file from the network location.
I'm using Excel 07, which doesn't allow Application.FindFile, so I can't test this. However, I believe the issue may be that you need to Set the variable Wrkbook, not just assign it.
Change
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
to
Set WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
and let me know how that turns out!