I am trying to convert a directory full of .txt files to .xls using VBA. I am using the following code:
Sub TXTconvertXLS()
'Variables
Dim wb As Workbook
Dim strFile As String
Dim strDir As String
'Directories
strDir = "\\xx\xx\xx\xx\Desktop\Test\Test1\"
strFile = Dir(strDir & "*.txt")
'Loop
Do While strFile <> ""
Set wb = Workbooks.Open(strDir & strFile)
With wb
.SaveAs Replace(wb.FullName, ".txt", ".xls"), 50
.Close True
End With
Set wb = Nothing
Loop
End Sub
The issue is: when I run it, it immediately states that there is already a file with the name it's trying to save with in the directory. The name it shows even has a .xls extension, even if there are assuredly no .xls's in the directory yet! Any help would be greatly appreciated - thanks!
You seem to be missing strFile = Dir before Loop. Without it you are reprocessing the same TXT file.
Do While strFile <> ""
Set wb = Workbooks.Open(strDir & strFile)
With wb
.SaveAs Replace(wb.FullName, ".txt", ".xls"), 50
.Close False '<-already saved in the line directly above
End With
Set wb = Nothing
strFile = Dir '<- stuffs the next filename into strFile
Loop
See Dir Function
Related
I have 200 folders all with different names in a folder. Now, each folder with a different name has a macro excel file (.xlsm). I'm trying to edit all the files at once with a separate file. The code goes like this:
Sub Button1_Click()
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim strPath As String
Dim strFile As String
'Get the directories
strPath = "C:\Users\generaluser\Desktop\testing main folder\"
strFile = Dir(strPath)
'Loop through the dirs
Do While strFile <> ""
'Open the workbook.
strFileName = Dir(strPath & strFile & "*.xlsm")
'Open the workbook.
Set wb = Workbooks.Open(Filename:=strPath & strFile & "\" & strFileName , ReadOnly:=False)
'Loop through the sheets.
Set ws = Application.Worksheets(1)
'Do whatever
ws.Range("A1").Interior.ColorIndex = 0
'Close the workbook
wb.Close SaveChanges:=True
'Move to the next dir.
strFile = Dir
Loop
End Sub
But this doesn't work. I have tried tweaking it but whatever i do either does nothing or causes an error. Can someone please help me get this code to work.
(also: "testing main folder" is the folder on my desktop which holds the 200 other folders which hold the .xlsm files.)
Put Option Explicit at the top of the module. You'll get some compiler errors, one of them being that strFileName isn't declared. This would have been a great clue as to where to look, because the problem is that you're using two variable names that have roughly the same meaning when you read them, and they're getting mixed up.
After you're done fixing the variables, take a look at the documentation for the Dir function. The second issue is that you're also calling Dir multiple times in the loop, which means that you're skipping results.
It should look something more like this:
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim file As String
'path never changes, so make it a Const
Const path = "C:\Users\generaluser\Desktop\testing main folder\"
'This returns the first result.
file = Dir$(path & "*.xlsm")
Do While file <> vbNullString
Set wb = Workbooks.Open(Filename:=path & file, ReadOnly:=False)
Set ws = Application.Worksheets(1)
'Do whatever
wb.Close SaveChanges:=True
'This returns the next result, or vbNullString if none.
file = Dir$
Loop
I have been able to get some code to open the most up to date file located on a share drive. The part of code that i'm really struggling with is the last part which tries to copy and paste the contents of that file into my master - i tried recording this last part and alter that code but have had no luck - i feel like im on the right track but would appreciate any pointers! the specific error is "Run-time error '1004'"
Sub GetLatestFile()
Dim strFolder As String
Dim strFile As String
Dim latestFile As String
Dim dtLast As Date
' assign variables
strFolder = "Z:\PRICING1\1Mbs Pricing1\MBSREVAL11\21016111\" 'The end of this path must have a \ on it
strFile = Dir(strFolder & "\*.*", vbNormal) ' Any File
' strFile = Dir(strFolder & "\*.xls*", vbNormal) ' Excel Files
' strFile = Dir(strFolder & "\*.csv", vbNormal) ' CSV Files
' loop through files to find latest modified date
Do While strFile <> ""
If FileDateTime(strFolder & strFile) > dtLast Then
dtLast = FileDateTime(strFolder & strFile)
latestFile = strFolder & strFile
End If
strFile = Dir
Loop
MsgBox latestFile
Workbooks.Open (latestFile)
Worksheets("Ratesheet").Activate
Range(A7).Select
Selection.copy
Windows("RMBS Pricing_New v5 (version 1) [Autosaved]").Activate
Range("A7").Select
ActiveSheet.Paste
Windows(latestFile).Activate
End Sub
Assuming that RMBS ... is the master file:
Workbooks.Open(latestFile)
Worksheets("Ratesheet").Activate
Range("A7").Select
Selection.copy
' ActiveWorkbook.Close if needed
Workbooks.Open("RMBS Pricing_New v5 (version 1) [Autosaved]")
Range("A7").Select
Selection.Paste
' Save/close as needed
This is the simplest way to achieve what you want. Avoid the use of .Select/.Activate. You may want to see THIS
My Assumptions:
The file that you are trying to open can be opened in Excel
You are running the code from RMBS Pricing_New v5 (version 1). If not then declare another workbook object and assign this workbook to that object.
Is this what you are trying? (Untested)
Sub GetLatestFile()
Dim strFolder As String, strFile As String, latestFile As String
Dim dtLast As Date
Dim wbThis As Workbook, wbThat As Workbook
Dim wsThis As Worksheet, wsThat As Worksheet
Set wbThis = ThisWorkbook
'<~~ Change this to the relevant sheetname where you want to paste
Set wsThis = wbThis.Sheets("Sheet1")
'
'~~> Your code to find the latest file
'
Set wbThat = Workbooks.Open(latestFile)
Set wsThat = wbThat.Sheets("Ratesheet")
wsThat.Range(A7).Copy wsThis.Range("A7")
End Sub
In a quest to further never do anythign manual ever again
I made an it.xlsm that you have to put together in a folder with a specific file that has to be processed.
This it.xslm has three modules:
Masterfile
- renames the categories in C
-makes a worksheet per category in C
-saves those worksheets as .xslx. This results in 8 new files in a /Departement folder
Littlefiles
-renames the categories in E
-makes tabs for each category
-cleans up empty columns.
placeholder
Opens the .xls with the data
Applies Masterfile
Opens all the files created by masterfiles
makes tabs and cleans up empty columns.
Placeholder's code:
Sub OpenBigFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim Lastrow As Long
'open main file, apply masterfile moduke
Set wb = Workbooks.Open(ThisWorkbook.path & "\Depositformulier (Reacties).xlsx")
Call masterfile.total
wb.Close SaveChanges:=True
End Sub
This works fine.
Sub OpenAllFiles()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
myPath = ThisWorkbook.path & "\" & "Departement" & "\"
myFile = Dir(myPath & "*.xlsx")
Do While Len(Filename) > 0
DoEvents
Set wb = Workbooks.Open(myPath & myFile, True, True)
Call LittleFiles.total
wb.Close False
myFile = Dir
Loop
End Sub
Here I find myself in problems. I tried to rewrite it many times, using many examples, but always it seems to be stuck at Set wb = Workbooks.Open(Filename:=myPath & myFile)
What am I doing wrong?
Do you need my Littlefiles code?
Also, in general, is it correct that 'ThisWorkbook' will always refer to the this.xlm,even if in the mean time another workbook is active (this being ActiveWorkbook)?
Thanks a bunch
Here's my attempt, i think this way it'll be harder to go wrong as you will have the full path of the file already stored:
Sub OpenAllFiles()
'create an array
Dim myFiles As Variant
ReDim myFiles(500)
myPath = ThisWorkbook.Path
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
'search for at least 5 files in the folder specified above, add the entire path to the array
While myCount < 5
If Dir(myPath & "*.xlsm") <> "" Then
potentialFileToLoad = Dir(myPath & "*.xlsm")
While potentialFileToLoad <> ""
myFiles(myCount) = myPath & potentialFileToLoad
myCount = myCount + 1
potentialFileToLoad = Dir
Wend
End If
Wend
'change size of array to ammount of files found
ReDim Preserve myFiles(myCount - 1)
For Each ii In myFiles
'(Insert Open, Run code, close code here)
Workbooks.Open (ii), True, True
Call LittleFiles.Total
ActiveWorkbook.Close
Next ii
End Sub
try something similar to this
path = "path2folder" & "\" 'this is fairly important and probably why your code breaks?_
you cant add the backslash like you do above
Filename = Dir(path & "*.xl??")
Do While Len(Filename) > 0
DoEvents
Set wbk = Workbooks.Open(path & Filename, True, True)
'add your code
wbk.Close False
Filename = Dir
Loop
Sub LoopOtherRevenue()
Dim MyFile As String
Dim FilePath As String
FilePath = "C:\Users\jdubbaneh002\Desktop\Racetrac Other\"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "Book1.xlsm" Then
Exit Sub
End If
ActiveSheet.Range("A1:B14").Copy
Workbooks.Open (FilePath & MyFile)
ActiveWorkbook.Worksheets("A2) Monthly P&L (Source)").Activate
Range("B746:C759").PasteSpecial xlPasteValues
Application.CutCopyMode = False
ActiveWorkbook.Close
MyFile = Dir
Loop
End Sub
Get a paste special error on line Range("B746:C759").PasteSpecial xlPasteValues
The values are being pasted into a combo box. that is where the error is coming from.
For me it seems like the file path is missing a "\"
FilePath = "C:\Users\jdubbaneh002\Desktop\Racetrac Other"
...
MyFile = Dir(FilePath)
...
If MyFile = "Book1.xlsm" Then
...
Workbooks.Open (FilePath & MyFile)
Correct:
Workbooks.Open (FilePath & "\" & MyFile)
Did you try debugging? Where does it throw the error?
I can see all sorts of issues because you're using ActiveWorkbook after opening the 2nd workbook. Is ActiveWorkbook still pointing at the one where the code is, or is it actually pointing at the one you just opened?
Create & set an as Workbook variable as assign the one the code is in to one, and the workbook you're opening to the other. That will eliminate all confusion.
Try this:
Sub LoopOtherRevenue()
Dim rgCopy as Range
Dim MyFile As String
Dim FilePath As String
Dim wb as Workbook
FilePath = "destination folder\"
MyFile = Dir(FilePath)
Set rgCopy = ActiveSheet.Range("A1:B14")
Do While Len(MyFile) > 0
If MyFile = "Book1.xlsm" Then
Exit Sub
End If
set wb Workbooks.Open(FilePath & "\" & MyFile)
rgCopy.Copy Destination:=wb.Worksheets("A2) Monthly P&L (Source)").Range("B746")
wb.Close
MyFile = Dir
Loop
End Sub
I'm attempting to apply a macro that would copy and paste one specific worksheet (call the title of that worksheet "x") from one workBOOK ("x1") , onto a master workBOOK (call that workBOOK "xmaster"), after it copy and pastes the worksheet from workbook x1 it should also rename the title of the worksheet "x" to cell B3. This should be done before it moves to the next workbook.
It would need to do this for workBOOK x1 through, say, x100. I cannot refer to the workbook by name though, because they are each named a string of text that is in no real sortable method.
This code I know works, copying "x" from "x1" to "xmaster", along with renaming the sheet, and breaking the links, is the following:
Sub CombineCapExFiles()
Sheets("Capital-Projects over 3K").Move After:=Workbooks("CapEx Master File.xlsm").Sheets _
(3)
ActiveSheet.Name = Range("B3").Value
Application.DisplayAlerts = False
For Each wb In Application.Workbooks
Select Case wb.Name
Case ThisWorkbook.Name, "CapEx Master File.xlsm"
' do nothing
Case Else
wb.Close
End Select
Next wb
Application.DisplayAlerts = True
End Sub
The Activate Previous window isn't working, also not sure how to fix that portion of it.
I'm not sure how to build this to loop through all workBOOKs in the directory, however.
Should I use this:?
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xlsm if needed ?
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
'Your code here
strFilename = Dir()
Loop
An additional constraint is that it needs to not run the macro on xmaster (it will have an error because it will not have the sheet "x" which will be renamed from the previous workbooks.)
Thanks!
Matthew
like this?
(not tested)
Option Explicit
Sub LoopFiles()
Dim strDir As String, strFileName As String
Dim wbCopyBook As Workbook
Dim wbNewBook As Workbook
Dim wbname as String
strDir = "C:\"
strFileName = Dir(strDir & "*.xlsx")
Set wbNewBook = Workbooks.Add 'instead of adding a workbook, set = to the name of your master workbook
wbname = ThisWorkbook.FullName
Do While strFileName <> ""
Set wbCopyBook = Workbooks.Open(strDir & strFileName)
If wbCopyBook.FullName <> wbname Then
wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
wbCopyBook.Close False
strFileName = Dir()
Else
strFileName = Dir()
End If
Loop
End Sub
This bit will work to avoid running the macro on xmaster.
xmaster = "filename for xmaster"
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xls*", vbNormal) 'this will get .xls, .xlsx, .xlsm and .xlsb files
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
If strFileName = xmaster Then ' skip the xmaster file
strFilename = Dir()
End If
'Your code here
strFilename = Dir()
Loop
I can't help on the other part though. I don't see any Activate Previous window part in your code.