I have this code, that open all the files. The path is written in the cell (1,1). Eventually in the end of the path I have to put \, so I want to know if there is something that I could do for put \ automatically in the end of the path.
Sub openfiles()
Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer, finalRow As Integer
Application.ScreenUpdating = False
directory = Cells(1, 1)
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
Workbooks.Open (directory & fileName)
fileName = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Add a "\" to the end of the string
directory = Cells(1,1).Value & "\"
Related
I am trying to load a listbox with files in a folder through MFDialogbox Picker.
Unfortunately, its not working. Request your help.
Below is the code, I am using. Thanks
I find that 'mypath' variable is holding the correct name of the folder that was selected.
But, I find nothing is working thereafter. Please help.
Private Sub UserForm_Initialize()
Dim myfiles As String, mypath As String
Dim fileList() As String
Dim fName As String
Dim fPath As String
Dim I As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then Exit Sub
mypath = .SelectedItems(1)
DoEvents
End With
MsgBox mypath
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
ReDim fileList(1 To I)
fName = Dir(mypath)
MsgBox fName
While fName <> ""
'add fName to the list
I = I + 1
ReDim Preserve fileList(1 To I)
fileList(I) = fName
'get next filename
fName = Dir()
Wend
'see if any files were found
If I = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list and add to listbox
For I = 1 To UBound(fileList)
Me.ListBox1.AddItem fileList(I)
Next
End Sub
The problem is that I is 0 (as it is not set) when reaching ReDim fileList(1 To I). If you replace it with ReDim fileList(1 To 1), it should work.
First, let me brief scenario. I want to Import specific CSV file from the user-provided location. I am able to Import it with Fix file name.
Now, I want to Import a CSV file which changing one file name each time.
E.g.
Newdata_Files_LMBN_124587
Newdata_Files_LMBN_458965
Newdata_Files_LMBN_134654
Newdata_Files_LMBN_894354, etc...
I have written code for it, but it doesn't work
Sub zzandand(Optional opt As String)
Application.ScreenUpdating = False
Dim compd1, compd2 As String
Dim ws As Worksheet
Dim rng As Range
Dim path As Variant
Dim tfr1, tfr2 As String
Set path = UserForm1.TextBox1
compd1 = path & "\" & Newdata_Files_ & "*" & ".csv"
If Dir(compd1, vbDirectory) = vbNullString Then
MsgBox ("The file Newdata_Files(csv) could not be found")
Unload UserForm1
End
Else
Workbooks.Open (compd1)
ActiveSheet.Activate
Sheets.Copy Before:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = "compd2"
tfr1 = ActiveSheet.Range("A1").Value
ActiveSheet.Range("A1").Value = UCase(tfr1)
Workbooks("compd1").Close
End If
Application.ScreenUpdating = True
End Sub
Untested:
Sub zzandand(Optional opt As String)
Dim compd1 As String
Dim ws As Worksheet, wb As Workbook
Dim path As Variant
path = Trim(UserForm1.TextBox1)
If Right(path, 1) <> "\" Then path = path & "\" '<<< ensure trailing "\"
compd1 = Dir(path & "Newdata_Files_*.csv") '<<< any matches?
If Len(compd1) = 0 Then '<<< no need for Dir here....
MsgBox "The file Newdata_Files(csv) could not be found"
Unload UserForm1
Else
Set wb = Workbooks.Open(path & compd1) '<<< use the full path!
wb.Sheets(1).Copy _
Before:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
wb.Close False 'close without saving
Set ws = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ws.Name = "compd2"
ws.Range("A1").Value = UCase(ws.Range("A1").Value)
End If
End Sub
I am facing issues with VBA's looping through a list of files in a directory.
I need to loop through files which only have the word CITIES in the file name. But some times some files with the word CITIES might have a corresponding FINANCE file and hence I have to loop through the Folder again to find the finance file and extract information from it. I have written a funtion to get the file name if it exists and the biggest issue is the myFile = Dir which doesn't work as i hoped it would. I have the code which is here.
Sub getTheExecSummary()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
myPath = "C:\Users\MORPHEUS\Documents\Projects\"
myExtension = "*CITIES*.xls"
myFile = Dir(myPath & myExtension)
Debug.Print myFile
Do While Len(myFile) > 0
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
Dim prntStr As String
prntStr = wb.Worksheets("Sheet1").Cells(1, 1) & " (n= " _
& wb.Worksheets("Sheet2").Cells(12, 3) & ")"
Dim LookUpStr As String
LookUpStr = wb.Name
replaceStr = Left(LookUpStr, 10)
LookUpStr = Replace(LookUpStr, replaceStr, "")
Dim DoesTheFIleexist As String
DoesTheFIleexist = fileLoation(myPath, LookUpStr)
If (Len(DoesTheFIleexist) > 0) Then
Debug.Print (DoesTheFIleexist)
End If
Workbooks("ExecutiveSummary.xlsm").Sheets("Sheet1").Range("A1").Value = myFile
wb.Close SaveChanges:=False
'Get next file name
Debug.Print myFile
myFile = Dir
Loop
End Sub
Function fileLoation(filePath As String, LookUpStr As String) As String
Dim financeStr As String
Dim myFile1 As String
financeStr = "*FIN*.xls"
myFile1 = Dir(filePath & financeStr)
Do While Len(myFile1) > 0
Debug.Print ("")
Debug.Print (myFile1)
' If InStr(myFile1, LookUpStr) > 0 Then
' fileLoation = myFile1
' Else
' fileLoation = ""
' End If
myFile1 = Dir
Loop
End Function
The issue is that when the myFIle1 = Dir in the function finishes executing, the original myFile = Dir also is at its end (at least I think it is)
There is no way around this issue, that's just how the Dir Function works.
Instead, look into using a FileSystem object in the sub-function.
Alternatively, you can store all the filenames in the main function into an Array to loop thru instead of nesting your Dir functions like this:
Dim sFiles() as String
Dim sFilename as String
ReDim sFiles(0)
sFilename = Dir(myPath & "*CITIES*.xls")
Do Until sFilename = ""
ReDim Preserve sFiles(UBound(sFiles) + 1)
sFiles(UBound(sFiles)) = sFilename
sFilename = Dir()
Loop
Then you have found all your CITIES in a 1 based Array to loop thru.
I've written a macro to process data within all files in a specified folder. However, it skips the first file in the folder. The problem is that the first file is referenced on this line:
FileName = Dir(path)
but the next file is referenced with this line:
FileName = Dir()
Full code:
Sub data_gatherer() 'skips ESAM_50
'Removes unrealistic data and sums the no. starts/hours run for each pump stream
Application.ScreenUpdating = False
Dim sheet As Worksheet
Dim calcSheet As Worksheet
Dim path As String
Dim ColCount As Integer
Dim StreamCode As String
Dim StreamSum As Double
Dim NextRow As Double
Dim FilePath As String
Dim FileName As String
Dim i As Integer
Dim SumRange As range
Dim SheetName As String
Dim sSrcFolder As String
sSrcFolder = "C:\IRIS MACRO TEST ZONE\SPS IRIS Bulk Data\" ' unprocessed data
path = sSrcFolder & "*.csv" 'files withing sSrcFolder
FileName = Dir(path)
Do While FileName <> ""
FileName = Dir() '''''skips first file here'''''''''''''''''''''''''''''''''''''''''''''''
FilePath = sSrcFolder & FileName
If FilePath = "C:\IRIS MACRO TEST ZONE\SPS IRIS Bulk Data\" Then ''' avoids error message for " .csv"
Exit Do
End If
Workbooks.Open (FilePath) 'error here - looks for "" filename
SheetName = Left(FileName, 10)
With Workbooks(FileName).Sheets(SheetName)
ColCount = .Cells(3, .Columns.count).End(xlToLeft).Column 'COUNT COLUMNS WITH DATA need to start with col 2
For i = 2 To ColCount 'i=2 to avoid date column
Call data_cleaner_all(FileName, SheetName, i)
Call StreamCalcs(NextRow, FileName, SheetName, SumRange, i)
Next i
End With
Workbooks(FileName).Saved = True
Workbooks(FileName).Close
Loop
Application.ScreenUpdating = True
End Sub
Put FileName = Dir() at the end of the loop, directly before the
Loop
line.
Edit re:
What is the difference in meaning between FileName = Dir() and FileName = Dir(path) ?
Dir(path) initializes the Dir function, and returns the first file/folder name. Dir() is always a follow-up call to a Dir(path) that came before, and returns the next file/folder.
If you call Dir() without having called Dir(path) before, you get a runtime error.
I have a macro 'macro1' that convert all *.xls files within a folder to *.csv. After converting them, I merge rows using the command prompt. The I convert the merged file into an xls using macro2. Everything is working fine but when a value is something like 123456789123456 the resulting csv value is something like 1234E+11. How to keep the number format between converted files?
here are my macros
macro1
Option Explicit
Sub ConvertToCSV()
Dim i As Long
Dim NumFiles As Long
Dim FileName As String
Dim FileNames() As String
FileName = Dir(ThisWorkbook.Path & "/*.xls")
NumFiles = 1
ReDim Preserve FileNames(1 To NumFiles)
FileNames(NumFiles) = FileName
Do While FileName <> ""
FileName = Dir()
If FileName <> "" Then
NumFiles = NumFiles + 1
ReDim Preserve FileNames(1 To NumFiles)
FileNames(NumFiles) = FileName
End If
Loop
Application.DisplayAlerts = False
For i = 1 To UBound(FileNames)
If FileNames(i) <> ThisWorkbook.Name Then
Workbooks.Open FileName:=ThisWorkbook.Path & "\" & FileNames(i)
ActiveWorkbook.SaveAs _
FileName:=Left(FileNames(i), Len(FileNames(i)) - 4) & ".csv", _
FileFormat:=xlCSV
ActiveWorkbook.Close
End If
Next i
Application.DisplayAlerts = True
End Sub
and the macro2
Sub FromCSVToXLS()
Dim myWB As Workbook, WB As Workbook
Dim L As Long, x As Long, i As Long
Dim v As Variant
Dim myPath
Dim myFile
Set myWB = ThisWorkbook
Application.ScreenUpdating = False
Sheets(1).Cells.ClearContents
myPath = "C:\Folder1\Folder2\" '<<< change path
myFile = "myFile.csv" '<<< change file name
Set WB = Workbooks.Open(myPath & myFile)
ActiveSheet.UsedRange.Copy myWB.Sheets(1).Range("A1")
ActiveWorkbook.Close False
L = myWB.Sheets(1).UsedRange.Rows.Count
For i = 1 To L
v = Split(Cells(i, 1), ",")
For x = 0 To UBound(v)
Cells(i, x + 1) = v(x)
Next x
Next i
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= "D:\data folder\1.xls"
Application.DisplayAlerts = True
myWB.Save
Application.ScreenUpdating = True
End Sub
PS: the command prompt is not altering the number format. VERIFIED!
Thank you
SOLVED!!
I did this:
Open the merged file
select the concerned column
right clic on the column
and I changed the format of all column's cells.