简体   繁体   中英

Copy contents of CSV files to an exisiting workbook then move CSV

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM