I'm trying to:
Open a CSV file generated daily (with changing file name) from a specific folder, paste the contents into a different Excel workbook, then move the CSV file to a subfolder within the original folder.
Filter the copied data, extract filtered data into a separate worksheet, which will become a large table of data.
Repeat this process until no files are left in the folder where the CSV files were originally.
I wrote a macro to open one CSV file, (if you specify the exact file name) then copy the contents to the Excel workbook.
I also wrote a macro that moves all files that are CSVs within a folder to a subfolder.
The problem I am having is combining the two.
Sub Master()
'Open File
Dim rDest As Range
Set rDest = ThisWorkbook.Sheets("Paste Here").Range("A1:Z300")
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\Users\danielt\Desktop\CSV Files"
MyFile = Dir(MyFolder & "\*.csv")
Do While MyFile <> ""
Workbooks.Open filename:=MyFolder & "\" & MyFile
'Copy Contents
Sheets(1).Select
Sheets(1).Range("A1:Z300").Select
Selection.Copy
'Paste Contents into "Paste here" sheet
rDest.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = False
'Close opened file
ActiveWorkbook.Close SaveChanges:=False
'Move to new folder named "harvested"
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String
FromPath = "C:\Users\danielt\Desktop\CSV Files"
ToPath = "C:\Users\danielt\Desktop\CSV Files\Harvested"
FileExt = "*.csv*"
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
'End If
'FNames = Dir(FromPath & FileExt)
'If Len(FNames) = 0 Then
'MsgBox "No files in " & FromPath
'Exit Sub
End If
Set FSO = CreateObject("scripting.filesystemobject")
'FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
'Apply filter and copy & paste to report
'The filter is very long so I haven't included this. (But it runs fine)
'Transpose data from "report" to "raswcsvdata"
Sheets("Report").Select
Range("C3:C33").Select
Selection.Copy
Sheets("RawCSVdata").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'Clear report & paste here
Public Function GetValueFromDelimString(sPackedValue As String, nPos As Long, Optional sDelim As String)
Dim sElements() As String
sElements() = Split(sPackedValue, sDelim)
If UBound(sElements) < nPos Then
GetValueFromDelimString = ""
Else
GetValueFromDelimString = sElements(nPos)
End If
End Function
Function FindN(sFindWhat As String, sInputString As String, N As Integer) As Integer
Dim J As Integer
Application.Volatile
FindN = 0
For J = 1 To N
FindN = InStr(FindN + 1, sInputString, sFindWhat)
If FindN = 0 Then Exit For
Next
End Function
' Open next file
MyFile = Dir
Loop
End Sub
This is not a complete answer because I am not sufficiently clear about your intentions. However, I think I can help you move forward.
I think John Coleman's comment about Dir
and File System Object
is correct but not fully explained. Dir
is old technology. I suspect that with most programming languages it would be “depreciated” and scheduled for removal from the specification. MS does not do this sort of thing for Excel VBA. It has introduced the newer File System Object
which have more functionality. I classify FSOs as harder to learn to use correctly but, once fully understood, as more convenient. FSOs will do everything that Dir
will do but the reverse is not true. John is recommending that if you are going to use some FSO functionality then do not also use the “obsolete” statements and methods it replaces. However, it is not essential to drop Dir
. I was taught: “Get your code working then make it better faster, more elegant, etc.” I think you have more important problems than use of two technologies.
Please indent your code. Within each Sub … End Sub
, If … End If
, For … Next
, etc. step in a couple of spaces. This makes your code so much easier to read and makes it easier to spot nesting errors.
Your code will not execute. Within Sub Master … End Sub
you have two functions: GetValueFromDelimString
and FindN
. You cannot nest in this way. Move these functions to below the End Sub
for Sub Master
.
Your functions seem to be designed to help parse the line of a CSV file. They do not look powerful enough to achieve this objective. How would you use these functions to parse this line?
"Field1", "Field2A, Field2B", "Field3", "Field4A""FieldB"
Please replace variable type Integer
with Long
. Integer
specifies a 16-bit integer which requires special (that is slow) processing on 32 and 64-bit computers.
Please move the following outside the loop so it is only performed once:
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String
FromPath = "C:\Users\danielt\Desktop\CSV Files"
ToPath = "C:\Users\danielt\Desktop\CSV Files\Harvested"
FileExt = "*.csv*"
The above fixes some errors. Please try the corrections I have suggested. Do these corrections fix your problem? If not I will make further suggestions.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.