here is my complete code for extracting data from a CSV file which is delimited with a semi colon, it extracts the data and builds a report to email to each group, you can edit out the bits you dont require
the way it gets around the delimiter problem is to create a file called schema.ini in the same folder as the data file which describes the format and also the fields, I have given them different names for my process different to the column headers in the original file. You will see the format of the file in the routine createSchema, i just create it each time as this is used from outlook by many people
My process first queries the file and extracts all of the unique actiongroups and then loops thru and finds all records for each actiongroup, with a second call to ADO
you can remove the outlook bit and pull whatever columns straight into excel, cant remember the syntax but found it on my travels, will update when I find it, was a simple one liner
here is my code from top to bottom
'****
'
' Author Jim Ward
' Creation 5th June 2009
'
' Procedure to hopefully go someway to automating the Monday event of
' Notification of Suspended Incidents sent to a group of people
'
' Currently the exercise is manual and requires quite a bit of time
'
' Here is the plan
'
' When the email is received from Easy Vista, click on the link given
' at the top of the web page opened, click on the export to spreadsheet button and
' choose to save to my document as the name suggested
'
' the routine below will look for the file and rename it to a shorter name the ADODB
' function can handle.
'
' it will then open the file and look for a unique list of groups to report
' next it will take each of these groups in turn and return all records for that group SORTED
' using this it will create an email for the group and address it to the correct recipient
'
' IT WILL NOT SEND THE EMAIL, because of limitation I cannot be bothered working around, it will
' not add IT SERVICE DESK as the sender, this can be done manually and the contents can be visually
' checked for accuracy, then click on SEND
'
'****
' Declare some global variables
'****
Public IntAddress As Integer
Public StrAddressBook(10, 1) As String
Public StrAddressFile As String
Public StrPathToTextFile As String
Sub EmailNotificationSuspended()
'****
' Setup constants for the SQL query
'****
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
'****
' Declare stuff
'****
Dim IntGroupCount As Integer
Dim IntNextGroup As Integer
Dim StrGroup As String
Dim StrGroups(10) As String
Dim StrFile As String
Dim StrMonster As String
Dim StrSQL As String
Dim StrMailBody As String
Dim StrSignature As String
'****
' create objects that we need
'****
Set objConnection = CreateObject("ADODB.Connection")
Set ObjRecordSet = CreateObject("ADODB.Recordset")
'****
' Rename the EV monster filename to something ADODB can handle
' it does not like long names, check it exists first
'****
StrPathToTextFile = MyDocuments()
StrMonster = "\Automatic_Notification_of_suspended_Incidents_due_for_reactivation.csv"
If Not FileExists(StrMonster) Then
MsgBox ("Please follow the link in the email from Easy Vista and save the file to My Documents using the default filename suggested")
Exit Sub
End If
StrFile = "\Automatic.csv"
Name StrPathToTextFile & StrMonster As StrPathToTextFile & StrFile
'****
' create schema file, may become a file copy in the future
'****
Call CreateSchema
'****
' Load address book from text file, again maybe a filecopy in the future to keep one master list
'****
If Not FileExists("\Notify_Emails.txt") Then
MsgBox ("You do not have address file NOTIFY_EMAILS.TXT contact IT Service Desk, save the file to My Documents")
Exit Sub
End If
Call LoadAddressBook
'****
' create the standard signature common to all emails
'****
StrSignature = BuildSignature()
'****
' All preparatory work done, lets begin the main process
'****
'****
' Open JET connection to our data file
'****
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & StrPathToTextFile & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
'****
' Build SQL strings to get unique categories in no order
'****
StrSQL = "SELECT DISTINCT ActionGroup FROM " & StrFile
'****
' Execute the SQL and get the results and store for next stage
'****
ObjRecordSet.Open StrSQL, objConnection, adOpenStatic, adLockOptimistic, adCmdText
IntGroupCount = 0
Do Until ObjRecordSet.EOF
StrGroups(IntGroupCount) = ObjRecordSet.Fields.Item("ActionGroup")
IntGroupCount = IntGroupCount + 1
ObjRecordSet.MoveNext
Loop
IntGroupCount = IntGroupCount - 1
ObjRecordSet.Close
'****
' Build SQL strings to get all records for each category in sorted order
'****
For IntNextGroup = 0 To IntGroupCount
StrSQL = "SELECT * FROM " & StrFile
StrSQL = StrSQL & " WHERE ActionGroup Like '" & StrGroups(IntNextGroup) & "%' order by SUPPORT, LATESTDATE"
'****
' Execute the SQL, get the results and build our email body string
'****
ObjRecordSet.Open StrSQL, objConnection, adOpenStatic, adLockOptimistic, adCmdText
StrMailBody = "Incident Number Date Analyst" + vbCrLf
Do Until ObjRecordSet.EOF
a = ObjRecordSet.Fields.Item("ActionGroup")
b = ObjRecordSet.Fields.Item("IncidentNumber")
c = ObjRecordSet.Fields.Item("Support")
d = ObjRecordSet.Fields.Item("LatestDate")
d = Format(d, "dd/mm/yyyy")
StrMailBody = StrMailBody + b + vbTab + CStr(d) + vbTab + c + vbCrLf
ObjRecordSet.MoveNext
Loop
ObjRecordSet.Close
'****
' Create a new email for each group of interest
'****
Dim msg As Outlook.MailItem
Set msg = Application.CreateItem(olMailItem)
msg.To = FindAddress(StrGroups(IntNextGroup))
msg.Subject = "Automatic Notification of Suspended Incidents Due For Reactivation :- " + StrGroups(IntNextGroup) + " :- " + Format(Now, "yyyymmdd")
msg.Body = StrMailBody & vbCrLf & vbCrLf & StrSignature
msg.Display
Set msg = Nothing
Next
End Sub
Function MyDocuments() As String
Dim WSHShell As Object
Set WSHShell = CreateObject("Wscript.Shell")
MyDocuments = WSHShell.SpecialFolders("MyDocuments")
Set WSHShell = Nothing
End Function
Function FindAddress(StrActionGroup As String) As String
For j = 0 To IntAddress
If StrAddressBook(j, 0) = "[" & UCase(StrActionGroup) & "]" Then
FindAddress = StrAddressBook(j, 1)
Exit For
End If
Next j
End Function
Private Function FileExists(fname) As Boolean
' Returns TRUE if the file exists
Dim x As String
x = Dir(StrPathToTextFile & fname)
If x <> "" Then FileExists = True _
Else FileExists = False
End Function
Function BuildSignature() As String
BuildSignature = "IT Service Desk" & vbCrLf
End Function
Sub CreateSchema()
Open StrPathToTextFile & "\schema.ini" For Output As #1
Print #1, "[Automatic.csv]"
Print #1, "Format=Delimited(
"
Print #1, "ColNameHeader=True"
Print #1, "MaxScanRows=0"
Print #1, "Col1=IncidentNumber Text"
Print #1, "Col2=ActionGroup Text"
Print #1, "Col3=Support Text"
Print #1, "Col4=LatestDate DateTime"
Close #1
End Sub
Sub LoadAddressBook()
Open StrPathToTextFile & "\Notify_Emails.txt" For Input As #1
IntAddress = 0
Do While Not EOF(1)
Input #1, StrAddressBook(IntAddress, 0)
Input #1, StrAddressBook(IntAddress, 1)
IntAddress = IntAddress + 1
Loop
IntAddress = IntAddress - 1
Close #1 ' Close file.
End Sub
