View Single Post
 
Old 04-22-2016, 09:18 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

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
Reply With Quote