I assume the file content will look like
Job No,PackageCode,File Name,Date Dropped,Quantity,Status
462930,AFA-XWK,AFA-XWK_5034985A2-0001-.PS,11/04/2016 15:28,681,Confirmed
462693,CVX-XWK,CVX-XWK_5035125A4-0001-.PS,11/04/2016 15:28,12,Confirmed
462692,KA-XWK,KA-XWK_5035125A3-0001-.PS,11/04/2016 15:28,26,Confirmed
463104,KA-XWK,KA-XWK_5036183A2-0001-.PS,11/04/2016 15:28,17,Confirmed
461909,KA-XWK,KA-XWK_5015104A2-0001-.PS,11/04/2016 15:28,4,Confirmed
Do you want the results in an Excel format file, or a CSV text file (presumably without the headers)? CSV would be infinitely quicker. The code below is very fast acting.
Your quoted macro has some potential issues.
1. It is probably more correct to use the attachment filename rather than the display name, unless you can guarantee that they are the same.
2. Graphics in the message (e.g. in an e-mail signature) are treated as attachments, so it is probably better to restrict the process to CSV format attachments.
3. Is there any possibility of duplicated filenames? If so this will have to be allowed for as your process will simply overwrite existing names.
4. Why not incorporate the extraction process in your macro, rather than process the folder separately? That way there would be no need to worry about storing the extracted files, or duplicated filenames.
The following macro will create and and append to a named CSV file the CSV files from a folder selected from the code:
Code:
Option Explicit
Const strMasterPath As String = "C:\Path\Forums\Master.csv" 'The full name of the master csv
Sub ProcessCSVFiles()
'Graham Mayor - www.gmayor.com
'The lngCount variable is used to determine whether to add the header row to the master file
Dim strPath As String
Dim strFile As String
Dim lngCount As Long
lngCount = 0
If FileExists(strMasterPath) Then lngCount = lngCount + 1
strPath = BrowseForFolder("Select folder containing the CSV files")
If strPath = vbNullString Then GoTo lbl_Exit
strFile = Dir$(strPath & "*.csv")
While strFile <> ""
lngCount = lngCount + 1
If lngCount = 1 Then
GetCSVData strPath & strFile, True
Else
GetCSVData strPath & strFile
End If
DoEvents
strFile = Dir$()
Wend
MsgBox "Finished"
lbl_Exit:
Exit Sub
End Sub
Sub GetCSVData(sfName As String, Optional bHeader As Boolean = False)
'Graham Mayor - www.gmayor.com
'If vHeader = true then write the header row
'The header row is a row that contains the text "Job No"
Dim sTextRow As String
Dim iFileNo As Integer
iFileNo = FreeFile
Open sfName For Input As #iFileNo
Do While Not EOF(iFileNo)
Line Input #iFileNo, sTextRow
If bHeader Then
AddToMaster sTextRow
Else
If InStr(1, sTextRow, "Job No") = 0 Then
AddToMaster sTextRow
End If
End If
Loop
Close #iFileNo
lbl_Exit:
Exit Sub
End Sub
Sub AddToMaster(strLine As String)
'Graham Mayor - www.gmayor.com
'strline is the line of text to be added
Dim oFSO As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.OpenTextFile(strMasterPath, 8, True, 0)
oFile.Write strLine & vbCrLf
oFile.Close
lbl_Exit:
Set oFSO = Nothing
Set oFile = Nothing
Exit Sub
End Sub
Function BrowseForFolder(Optional strTitle As String) As String
'Graham Mayor - www.gmayor.com
'strTitle is the title of the dialog box
Dim fDialog As FileDialog
On Error GoTo err_handler
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = strTitle
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then GoTo err_handler:
BrowseForFolder = fDialog.SelectedItems.Item(1) & Chr(92)
End With
lbl_Exit:
Exit Function
err_handler:
BrowseForFolder = vbNullString
Resume lbl_Exit
End Function
Public Function FileExists(strFullName As String) As Boolean
'Graham Mayor - www.gmayor.com
'strFullName is the name with path of the file to check
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFullName) Then
FileExists = True
Else
FileExists = False
End If
lbl_Exit:
Set fso = Nothing
Exit Function
End Function