my folder contains many files. And I have similar folder for each months. Datafiles are having same name but they are on different folders. What I want is to copy a specific column (computed result) of previous month's datafile to new month's datafile.
My code is
Dim fileName1, Pathname1 As String
Pathname1 = "c:\Charts\1\"
For Each vFile1 In vArr1
fileName1 = Dir(Pathname1 & vFile1 & "\" & "*.xlsx")
Do While fileName1 <> ""
Set WB1 = Workbooks.Open(Pathname1 & vFile1 & "\" & fileName1)
WB1.Application.ScreenUpdating = False
WB1.ActiveSheet.Columns("M").Copy
WB1.Close (False)
For Each vFile In vArr
fileName = Dir(Pathname & vFile1 & "\" & "*.xlsx")
If fileName = fileName1 Then
Set WBD1 = Workbooks.Open(Pathname & vFile1 & "\" & fileName1)
WBD1.ActiveSheet.Columns("C").Select
WBD1.ActiveSheet.Paste
WBD1.Close (True)
Else
End If
Next
Loop
Next
What i am doing is
1. open a file
copy a column
checking the filenames are same
if they are same paste the copied data
BUt the loop gets infinite.
I debugged and couldn't find it
pls help
When you use the DIR function with an argument it finds the first file that matches the specified criteria. If you want to get the next file, use DIR() on its own.
In your code you are getting the first file over and over again and never reaching the condition where filename1 = ""
Related
I am looking for a way to save my files and add a count after each file, so file 1, next file will have 2 at the end of it and 3 then 4, and so on
ActiveWorkbook.SaveAs "C:\Martin\1BankFiles\Recon" & " " & Format(Now(), "DD-MMM-YYYY") & ".XLSX", FileFormat:=51
what to add to the above VBA code to achieve so.
You need a way to figure out which was the last file written (and if it was written today or earlier).
As your macro stops, using a global variable is not reliable. I guess the easiest way would be to look into the folder where you write the files.
The following function will do exactly that: look for all files with the current date in the file name, figure out the highest number and return the next "free" filename.
Function GetNextFilename()
Const BasePath = "C:\Martin\1BankFiles\"
Dim BaseFilename As String
BaseFilename = "Recon " & Format(Now(), "DD-MMM-YYYY") & "_"
Dim filename As String, filenumber As Long, largestNumber As Long
filename = Dir(BasePath & BaseFilename & "*.xlsx")
Do While filename <> ""
filenumber = Val(Mid(filename, Len(BaseFilename) + 1))
If filenumber > largestNumber Then largestNumber = filenumber
filename = Dir
Loop
GetNextFilename= BasePath & BaseFilename & (largestNumber + 1) & ".xlsx"
End Function
Your Save-commmand would simply be
ActiveWorkbook.SaveAs GetNextFilename, FileFormat:=xlWorkbookDefault
I'm trying to get a macro to work as a version history tool. I think I'm using basic methods here and there might be better ones out there but I think it's doable nonetheless. The error I get is "Subscript out of range". The culpript is the second to last line of my code, which is where I save a copy of the file. So this is my code:
Sub Historian()
Dim filePath As String
Static counter As Integer
Dim fileName As String
filePath = "A:\Downloads A\Ex_Files_Learning_VBA_Excel\Exercise Files\Ch05\WbkBackup"
For counter = 0 To 10
Workbooks.Open (filePath & counter)
On Error GoTo Handler:
Next counter
MsgBox ("counter has reached 10")
Exit Sub
Handler:
ThisWorkbook.Activate
fileName = ThisWorkbook.FullName
Workbooks(fileName).SaveCopyAs fileName:=(filePath & counter)
MsgBox ("ok, last version was: " & counter)
End Sub
Workbooks(filename) do not take the filename full path as argument, only the filename.
Change Workbooks(filename) to ThisWorkbook as suggested by Warcupine
To improve your code, I would suggest you not to test the opening of Workbook. This is long and then you have to close the workbooks you opened...
Instead you could use the Dir() function:
Check if the file exists using VBA
On Error GoTo Handler
should be placed before
Workbooks.Open (filePath & counter)
which should be:
Workbooks.Open (filePath & "\" & split(Thisworkbook.Name, ".")(0) & counter & "." & split(Thisworkbook.Name, ".")(1))
In fact, your code should look in this way:
Sub Historian()
Dim filePath As String, fileName As String, strExt As String
Static counter As Long
filePath = "C:\Teste VBA Excel\PROG BACKUP" ' "A:\Downloads A\Ex_Files_Learning_VBA_Excel\Exercise Files\Ch05\WbkBackup"
fileName = Split(ThisWorkbook.Name, ".")(0)
strExt = Split(ThisWorkbook.Name, ".")(1)
For counter = 0 To 10
On Error GoTo Handler:
Workbooks.Open (filePath & "\" & fileName & counter & "." & strExt)
Next counter
MsgBox ("counter has reached 10")
Exit Sub
Handler:
ThisWorkbook.SaveCopyAs fileName:=(filePath & "\" & fileName & counter & "." & strExt)
MsgBox ("ok, last version was: " & counter)
End Sub
But I think that checking the existing of the workbook by opening it, is not so appropriate way. I would suggest you to replace
On Error GoTo Handler:
Workbooks.Open (filePath & "\" & fileName & counter & "." & strExt)
with
If Dir(filePath & "\" & fileName & counter & "." & strExt) = "" Then GoTo Handler
Daily generated new Excel file with data will have the following name: "RawData_today date-time.xlsx", for example: "Report_2017-04-10-10-17-42.xlsx". I'm trying to set a right Path to the file, knowing only the first part of its name and ignoring the time-part?
As was suggested by #ShaiRado and #RobinMackenzie, the following code should work properly:
Dim RawDataPath As String
Dim FolderPath As String
FolderPath = ThisWorkbook.Path & "\"
RawDataPath = FolderPath & "Report" & format(Date, "yyyy-mm-dd") & "*.xlsx"
However, I am still getting the error message, and I think the issue is not in the line above.
I looked for a file using
RawDataPath = Dir$(FolderPath & "Report" & format(Date, "yyyy-mm-dd") & "*.xlsx")
If (Len(RawDataPath) > 0) Then
MsgBox "found " & RawDataPath
End If
Result -> the right file is found.
The second part of the code:
'check if the file exists
If FileExists(RawDataPath) = False Then RawDataPath = BrowseForFile("File not found. Please select the file.")
'check if the workbook is open
If Not IsWbOpen(RawDataPath) Then Workbooks.Open RawDataPath
Check if the file exists fails.
Run-time error '1004': Sorry, we couldn't find False.xlsx. Is it possible it was moved, renamed or deleted?
I don't undertand why does it look for a False.xlsx? What am I doing wrong?
Any help would be appreciated.
Okay, finally have found a solution, thanks to the post:
Dim RawDataPath As String
Dim FolderPath As String
FolderPath = ThisWorkbook.Path & "\"
RawDataPath = Dir$(FolderPath & "Report" & format(Date, "yyyy-mm-dd") & "*.xlsx")
If (RawDataPath <> "") Then
Workbooks.Open FolderPath & RawDataPath
Else
MsgBox "not found"
End If
Note: Dir$ function returns only the name of the file, not the whole path to it.
I am using the function below to extract data from other workbooks.
Function GetValue(path, file, sheet, ref)
'Retrieves a value from a closed workbook
Dim myArg As String
'Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
'Create the argument
myArg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
'Execute an XLM macro
GetValue = ExecuteExcel4Macro(myArg)
End Function
I am calling this function like this:
Sub TestGetValue()
Dim p As String, f As String
Dim s As String, a As String
p = "C:\Users\schaudha\Desktop\FIT transition\test simulation results"
f = "all cancer rate.xml"
s = "CONTENTS"
a = "A1"
MsgBox GetValue(p, f, s, a)
End Sub
This function seems to work only when the workbook is active. I mean, if I open the Excel file that I need data from and then run my subroutine, it works, but if it is closed, it doesn't work. I would also like it work when the workbook is closed. I am guessing I need to activate the workbook somehow before I use ExecuteExcel4Macro(myArg). How do I do that? I plan on using this function to extract data from thousands to cells from about a hundred workbooks, so I want to make this code as efficient as possible.
I think what you're looking for is (modified from your code):
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
else
CurrBook = Workbooks.Open Path & File
End If
'''Code here
CurrBook.Close
This will open the file, if it's found, and you'll be able to extract the data from it. I hope this helps!
This works
Function GetValue(path, file, sheet, ref)
'Retrieves a value from a closed workbook
Dim myArg As String
Dim CurrBook As Workbook
'Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
Application.Workbooks.Open (path & file)
'Create the argument
myArg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
'Execute an XLM macro
GetValue = ExecuteExcel4Macro(myArg)
Application.Workbooks(file).Close (False)
End Function
If you're going to open the workbook you don't need ExecuteExcel4Macro at all:
Function GetValue(path, file, sheet, ref)
Dim CurrBook As Workbook
'Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
Set CurrBook = Application.Workbooks.Open(path & file)
On Error Resume Next
GetValue = CurrBook.Sheets(sheet).Range(ref).Value
CurrBook.Close savechanges:=False
End Function
I have the following VBA code:
mainFile = ActiveWorkbook.Name
'select all excel files in this folder
fname = Dir(FPath & "\*.xls")
'go through all excel files in this folder
Do While fname <> ""
If (fname <> mainFile & fname <> uploadFile) Then
Debug.Print (mainFile & ":" & uploadFile & ":" & fname)
For some reason, the fname <> mainFile isn't preventing it from entering the loop, and I get the following from the Debug.Print statement:
functions.xls:UPLOADME.xls:functions.xls
And then the code just stops executing...no error...just nothing (I have a Debug.Print after the loop that is ignored along with everything else)
Am I not comparing them correctly?
It should be: fname <> mainFile And fname <> uploadFile
In VBA, the & operator is used to concatenate strings, not to perform a logical AND... "And" is the operator I was looking for.