-
OK, I've come up with something to get you started but there are a few tricky bits so I hope you're ready 
In your Excel file...
First, in the VBEditor, you'll need to go to Tools|References and add references to Microsoft Word 11.0 Library and Microsoft Outlook 11.0 Library so we can use them.
Add the code below in a new module, but first I should explain a few things:
First I'll explain whats going on at the moment... What I've done here is a file search in a pre-defined folder for TXT files. For each one, it's opened, each line is passed into the excel sheet1, your original code is run to create the dataset, the word doc (report) is opened and it auto merges from the dataset, the doc is given a name and saved, a new mail item is created, filled in and the doc attached, the mail sent and then it loops back to start again with the next text file.
Next, you'll need to change a few things in the code - the string constants for the folder/file locations need to be changed
You'll probably want to customize the doc filename and email content - I've commented the code so you can see what I mean
You may also need to reattach the datapath for the report doc if you chnage anything
There's also a complication that had me scratching my head for a while: MS have closed a security loophole that prevents the SQL connect for the merge from being run from VBA. There's an registry hack to open it back up detailed here:
http://support.microsoft.com/default...B;EN-US;825765
Then, I believe, you're good to go 
I should point out I don't have Outlook at home so I haven't been able to test that aspect yet but it should be ok 
From here, I don't think its a massive leap to get this all running automatically using some fancy Outlook rule/script combination - when I get back to work next week I'll check it out
Until then.. enjoy :-)
[VBA]'## These string constants will need to be changed accordingly ##'
Const TextFilePath As String = "C:\Documents and Settings\Killian\Desktop\txt"
Const WordDocFilePath As String = _
"C:\Documents and Settings\Killian\Desktop\Service Call Log Form Rev H.doc"
Const ExcelFilePath As String = _
"C:\Documents and Settings\Killian\Desktop\Service Call Inputs-RevB_K1.xls"
Const WordDocFileName As String = "Service Call Log Form Rev H.doc"
Const FinalReportFolder As String = _
"C:\Documents and Settings\Killian\Desktop"
Const strMailRecipient As String = "someone@somewhere.net"
Sub BatchReportGen()
'declare variables
Dim fs As Object, fso As Object, ts As Object
Dim i As Integer, r As Integer
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim olApp As Outlook.Application
Dim olNewMail As Outlook.MailItem
Dim wdFileName As String
'set objects required
Set fs = Application.FileSearch
Set fso = CreateObject("Scripting.FileSystemObject")
Set wdApp = New Word.Application
Set olApp = New Outlook.Application
With fs 'do a filesearch for all txt file in target folder
.NewSearch
.LookIn = TextFilePath
.Filename = "*.txt"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count 'with each found txt file in turn...
Set ts = fso.GetFile(.FoundFiles(i)).OpenAsTextStream(1, -2)
r = 1
Do Until ts.AtEndOfStream 'read each txt line into cell from A1 down
ActiveWorkbook.Sheets("Sheet1").Cells(r, 1).Value = ts.Readline
r = r + 1
Loop
'call the original routine to transfer the data
Data_Transfer_New
'open the mail merge doc and save it
Set wdDoc = wdApp.Documents.Open(WordDocFilePath)
'you may want to do something else with the filename so you don't get repeats
'since you're in Excel, you could grab a job number from the data perhaps
wdFileName = FinalReportFolder & "\ServiceCallLog_" & i & ".doc"
wdDoc.SaveAs wdFileName
wdDoc.Close
'create a new mail item, fill in, attach doc and send
Set olNewMail = olApp.CreateItem(olMailItem)
With olNewMail
.Recipients.Add strMailRecipient
.Subject = "Subject string here"
.Body = "Body text (if required)"
.Attachments.Add wdFileName
.Send
End With
Next i 'go to next found txt file and do it all again
'finished - quit apps
wdApp.Quit
olApp.Quit
Else
MsgBox "No text files found."
End If
End With
'release references
Set fs = Nothing
Set fso = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Set olNewMail = Nothing
Set olApp = Nothing
End Sub[/VBA]
K :-)

Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules