View Single Post
 
Old 04-13-2016, 06:05 AM
gbaker gbaker is offline Windows 7 32bit Office 2010 32bit
Competent Performer
 
Join Date: May 2012
Posts: 111
gbaker is on a distinguished road
Default Open csv files & copy and paste info into master file

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
Attached Images
File Type: jpg error.JPG (35.3 KB, 25 views)
Reply With Quote