Open csv files & copy and paste info into master file

gmayor · #1 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 · #2 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 · #3 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

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