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