View Single Post
 
Old 04-12-2016, 09:57 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,137
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com

Last edited by gmayor; 04-13-2016 at 03:02 AM.
Reply With Quote