Open csv files & copy and paste info into master file

gbaker · #1 04-12-2016, 10:46 AM

I am looking for a way to open multiple files located in a folder on my network, open each of them and copy and paste the information to one master file. I have some code that when the e-mails with the attachments come in the attachments are moved to a folder on the network. Now I would like to have some code to open each one of them up and copy and paste the information to one master file.
Here is what I have so far:

HTML Code:

Option Explicit

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
End Sub

Attached is an example fo the files that come in via e-mail
Had to change it to excel to be able to attach it.

gmayor · #2 04-12-2016, 09:57 PM

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

gbaker · #3 04-13-2016, 04:59 AM

Hi GMayor,
To start, Thank you so much.
The file content will look like what you sent.
Results can be in CSV format
1) File names are different for each:
Example would be:
RK195799
RK195845
RK195878
One file comes in each night.
2) No Possibility for duplicate file names

3) I set up a rule in outlook to take the files that come in and send them to a folder on the network. I attached a screen shot so you can see it.
4) How would I set it up to incorporate the extraction process into my macro?
Here is where the master file lives.
5) Const strMasterPath As String = "\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports\Master.csv"
'The full name of the master csv
6) Do you see any issues with the path?

gbaker · #4 04-13-2016, 06:05 AM

Hi Gmayor:
I tried the following code and got an error: See Screen shot attached error.jpg

HTML Code:

Option Explicit
Const strMasterPath As String = "\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports\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("\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports")
    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

gmayor · #5 04-13-2016, 10:39 PM

Sorry about that. The BrowseForFolder function does not work in Outlook VBA (I created it in Excel), and you have an extra quote in the strMasterPath definition which is probably responsible for the particular error.

In any case you seem to be using a common folder so it is unnecessary and as you are intending to follow my suggestion and process as the messages arrive, superfluous. I have posted a revised version and added a macro that can be used as a script with a rule that identifies the incoming messages and saves them to strPath. If you are batch processing then save the master in a different folder from the csv folder (as shown). It shouldn't matter if you are processing as they arrive.

The rule with the script ProcessAttachment would replace your original rule. It only has to identify the messages, the script will extract the csv and process it using the ancillary functions.

I have not tested the script as I don't have access to your network locations, but it should be OK.

Code:

Option Explicit
Const strMasterPath As String = "\\fngn.com\us\Projects\Print Production\Reports\Master.csv"    'The full name of the master csv
Const strPath As String = "\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports\"

Sub ProcessAttachment(oItem As MailItem)
Dim strFileName As String
Dim olAtt As Attachment
Dim lngCount As Long
    lngCount = 0
    On Error GoTo err_handler
    If oItem.Attachments.Count > 0 Then
        For Each olAtt In oItem.Attachments
            If Right(olAtt.FileName, 4) = ".csv" Then
                strFileName = strPath & olAtt.FileName
                olAtt.SaveAsFile strFileName
                Exit For
            End If
        Next olAtt
    End If
    If FileExists(strMasterPath) Then lngCount = lngCount + 1
    If lngCount = 1 Then
        GetCSVData strFileName, True
    Else
        GetCSVData strFileName
    End If
lbl_Exit:
    Exit Sub
err_handler:
    Err.Clear
    GoTo lbl_Exit
End Sub

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 strFile As String
Dim lngCount As Long
    lngCount = 0
    If FileExists(strMasterPath) Then lngCount = lngCount + 1
    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

Private Function FileExists(strFullName As String) As Boolean
'Graham Mayor - www.gmayor.com
'strFullName is the name with path of the file to check
Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FileExists(strFullName) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

gbaker · #6 04-14-2016, 06:25 AM

This seems like it should work. I won't know until tomorrow. The files come in at 7:00 PM. All files have already come in for yesterday. I put the code in This session so it should kick off when I open Outlook tomorrow morning. I'll let you know if it works.
If I want to automatically open another workbook after this runs can I add the following to the bottom of your code:

HTML Code:

Option Explicit

Sub Importfind()
'Goes to the folder, finds the csv file, opens it and then does the next step.
ChDir "\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports"

Application.FindFile
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'The next step separates the package code into two columns, example SCE XE instead of SCEXE which allows for wasy lookup by users.
'Then is copies everything and paste the first 7 columns to the tab called Master. The Master tab has formula's that matches the code SCE to another tab in which I developed a way to get the sponsor name and the provider.
   Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Columns("A:g").Select
    Selection.Copy
    
    Windows("DSG Drop Reports 2016.xlsm").Activate
    Columns("A:g").Select
    ActiveSheet.Paste
    Range("A1").Select
    Dim row, rwindex As Integer
    row = 0
    rwindex = 5
    Range("A2:G100000").Select
    Selection.Copy
    Sheets("Master").Select
    Range("a1").Select
    Do
       ActiveCell.Offset(1, 0).Activate
             
    Loop Until ActiveCell.Value = ""
 'The next step takes columns A-P and paste them to the Master resulting in:Job No  Sponsor Code    File Name   Date Dropped    Quantity    Status  POID  Provider    Sponsor Code    Sponsor name

    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("Data").Select
    Application.CutCopyMode = False
    Range("A8").Select
    Rows("2:2").Select
    ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("k2:k100000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("E2:E100000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DATA").Sort
        .SetRange Range("A1:k100000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("K1").Select
    Range("A2:G100000").Select
    Selection.ClearContents
    Sheets("Master").Select
    Cells.Select
    ActiveSheet.Range("$A$1:$G$174011").RemoveDuplicates Columns:=4, Header:= _
        xlYes
  'It also de-dupes because some of the records are duplicated. The csv files are a running list that keep adding records, which causes some duplication.
    
   Columns("E:E").Select
    Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
  
    
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
  
'The sponsor package codes tab comes from a table in sharepoint that needs to be updated i/e refreshed so any new data will be there.
    
    Sheets("Sponsor Package Codes").Select
    ActiveWorkbook.refreshall
'The Data tabe is just a sheet that I have the MACRO BUTTONS.
Sheets("DATA").Select
    Range("A1").Select
    

    
        
End Sub

I know I still have a ways to go but if your code works then I will be close to automating so I don;t have to run macros everyday or teach someone else if I am on vacations. Thank you so much for your help so far.

gmayor · #7 04-14-2016, 10:31 PM

The code doesn't go into ThisOutlookSession but an ordinary module (add one and paste it there instead). Because of Outlook security you may have to sign the project for it to work without security prompts (or at all). See http://www.gmayor.com/create_and_emp...gital_cert.htm.

I do not know if your code will work from Outlook (have you tested it) and am reluctant to try and decipher what it is supposed to do, without knowing what that is initially. Debugging other people's code is frustrating and time consuming.

gbaker · #8 04-15-2016, 05:36 AM

Hi Gmayor,
Thank you for your help anyway. I moved your code to a regular module, went into the rule and ran it but nothing happened. Maybe if I put the code into excel and try to run it it will work. Back to the drawing board. If it works, I was thinking of putting the excel workbooks in my startup so it will open when I sign in. If the code is in thissession hopefully it will automatically run. The I could set it up to do the additional code (My code) which I know works because I have been running that code every day. I just have to open it up each day and run the macros.
Thanks anyway for your help. It's not easy for me because I am just a beginner. I have a lot more to learn.
I did set up another rule see attached to see if it will work from outlook. Not likely. see attached.

gbaker · #9 04-22-2016, 09:18 AM

Hi Gmayor:
Can't get it to work in Outlook. Can you tell me how to amend the code below so I can get it to work in excel instead:

HTML Code:

Option Explicit
Const strMasterPath As String = "\\fngn.com\us\Projects\Print Production\Reports\Master.csv"    'The full name of the master csv
Const strPath As String = "\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports\"

Sub ProcessAttachment(oItem As MailItem)
Dim strFileName As String
Dim olAtt As Attachment
Dim lngCount As Long
    lngCount = 0
    On Error GoTo err_handler
    If oItem.Attachments.Count > 0 Then
        For Each olAtt In oItem.Attachments
            If Right(olAtt.FileName, 4) = ".csv" Then
                strFileName = strPath & olAtt.FileName
                olAtt.SaveAsFile strFileName
                Exit For
            End If
        Next olAtt
    End If
    If FileExists(strMasterPath) Then lngCount = lngCount + 1
    If lngCount = 1 Then
        GetCSVData strFileName, True
    Else
        GetCSVData strFileName
    End If
lbl_Exit:
    Exit Sub
err_handler:
    Err.Clear
    GoTo lbl_Exit
End Sub

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 strFile As String
Dim lngCount As Long
    lngCount = 0
    If FileExists(strMasterPath) Then lngCount = lngCount + 1
    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

Private Function FileExists(strFullName As String) As Boolean
'Graham Mayor - www.gmayor.com
'strFullName is the name with path of the file to check
Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FileExists(strFullName) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

gmayor · #10 04-22-2016, 11:02 PM

It can't work from a rule if you run the code from Excel. However let's start again as there is a potential issue with the earlier code, which causes the master file not to be created under some circumstances and the error handler scraps the process.

The following has been tested and does work, either from a rule that processes incoming messages, or you can run ProcessCSVFiles on a Windows folder full of files.

I have checked and both processes with create the master file if it doesn't exist and should only add the header from the first attachment when the master is created.

Replace all the original code with the following, in an ordinary module. Change the name of the script that the rule uses to match the change.

When processing from a rule, the macro creates a temporary file from the attachment to process. It doesn't save the attachment.

Code:

Option Explicit
Const strMasterPath As String = "\\fngn.com\us\Projects\Print Production\Reports\Master.csv"    'The full name of the master csv
Const strPath As String = "\\fngn.com\us\Projects\Print Production\Reports\DSG Drop reports\"

Sub CSVAttachment(olItem As Outlook.MailItem)
'Graham Mayor - www.gmayor.com
Dim strTempPath As String
Dim strFileName As String
Dim olAtt As Attachment
Dim lngCount As Long
Dim bAttached As Boolean
    strTempPath = Environ("Temp") & Chr(92)
    lngCount = 0
    On Error GoTo err_handler
    If olItem.Attachments.Count > 0 Then
        For Each olAtt In olItem.Attachments
            If Right(olAtt.FileName, 4) = ".csv" Then
                bAttached = True
                If FileExists(strMasterPath) Then lngCount = lngCount + 1
                strFileName = strTempPath & olAtt.FileName
                olAtt.SaveAsFile strFileName
                Exit For
            End If
        Next olAtt
    End If

    If lngCount = 1 Then
        GetCSVData strFileName
    Else
        GetCSVData strFileName, True
    End If
    If bAttached Then Kill strFileName    'Delete the temporary file
lbl_Exit:
    Exit Sub
err_handler:
    Err.Clear
    GoTo lbl_Exit
End Sub

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 strFile As String
Dim lngCount As Long
    lngCount = 0
    If FileExists(strMasterPath) Then lngCount = lngCount + 1
    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 bHeader = 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

Private Function FileExists(strFullName As String) As Boolean
'Graham Mayor - www.gmayor.com
'strFullName is the name with path of the file to check
Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FileExists(strFullName) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copy and Paste from File to File but File Names always change	aaronbauer1980	Excel Programming	1	04-15-2016 05:53 PM
Macro to open Multiple files and copy information to a master file	gbaker	Excel Programming	2	04-08-2016 08:44 AM
Keeping track of the original file when you copy/paste	sidbisk	Excel	2	09-01-2015 02:11 PM
Loop through files and Copy Table Row and Paste into Different Document	spiderman1369	Word VBA	2	10-15-2014 08:30 AM
Can't Copy and Paste until new message is open	tabletop	Outlook	0	12-04-2009 11:38 AM