p2p.wrox.com: Archives - access archive

access thread: save in Word and send as attachment

Message #1 by "Nikola" <Nikola@b...> on Wed, 27 Nov 2002 16:55:35 -0000

Hi all,

I create this code :

Private Sub cmbSendMail_Click()
On Error GoTo Err_cmbSendMail_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim objWord As Word.Application

    stDocName = "SendToWord"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

    Set objWord = CreateObject("Word.Application")
    With objWord
    .Visible = True
    .Documents.Open ("c:\_Radni\DFM\ForUSA\test.doc")
    .ActiveDocument.Bookmarks("Company").Select
    .Selection.Text = (CStr(Forms!SendToWord!Company))
    .ActiveDocument.Bookmarks("EmployeeID").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("VesselID").Select
    .Selection.Text = (CStr(Forms!SendToWord!VesselName))
    .ActiveDocument.Bookmarks("Date").Select
    .Selection.Text = (CStr(Forms!SendToWord!Date))
    .ActiveDocument.Bookmarks("OrderNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!OrderNo))
    .ActiveDocument.Bookmarks("PageNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!PageNo))
    .ActiveDocument.Bookmarks("Priority").Select
    .Selection.Text = (CStr(Forms!SendToWord!Status))
    .ActiveDocument.Bookmarks("EmployeeID1").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("DepartmentID").Select
    .Selection.Text = (CStr(Forms!SendToWord!Department))
    .ActiveDocument.Bookmarks("DirectPhone").Select
    .Selection.Text = (CStr(Forms!DirectLine!EmpName))
    .ActiveDocument.Bookmarks("EmailAddress").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmailAddress))


    End With

    objWord.ActiveDocument.Close
    objWord.Quit
    Set objWord = Nothing

Exit_cmbSendMail_Click:
    Exit Sub

Err_cmbSendMail_Click:
    If Err.Number = 94 Then
    objWord.Selection.Text = ""

    Else

    MsgBox Err.Number & vbCr & Err.Description

 End If

 Exit Sub

and I have two problems.First after sending form to Word all bookmark seting
are gone and second
how to send same test1.doc to outlook like attachmetn try Access. I have
half of code for open outlook with e-mail adress but i mess part for
attachment.


Code :

Private Sub cmdSendEmail_Click()
    Dim dbs As Database
    Dim rs As Recordset
    Dim strSql As String
    Dim strSubject, strMessage

    Set dbs = CurrentDb
    strSql = "SELECT * FROM Employees WHERE EmailCode = 1 "
    Set rs = dbs.OpenRecordset(strSql)

    strSubject = "Subject is - Test Access 97 email code"
    strMessage = "Meassage is - This is a customer message"

    Do Until rs.EOF
        DoCmd.SendObject acSendNoObject, , , rs!EmailAddress, , ,
strSubject, strMessage, True
        rs.MoveNext
    Loop
End Sub



Thanks,

Nikola

Message #2 by "Carnley, Dave" <dcarnley@a...> on Wed, 27 Nov 2002 09:26:47 -0600

I do both these things in one of my apps.  here is my code :) 
This code is from VB6, but it should work OK in Access if you have the
Outlook and Word object libraries referenced:


Emailing Attached documents:

Private Function EmailFile(fname As String, strEmailAddr As String, strSubj
as string) As Boolean
Dim myOLApp As New Outlook.Application
Dim myOLItem As Outlook.MailItem

On Error GoTo EmailFileError

    Set myOLItem = myOLApp.CreateItem(olMailItem)
    myOLItem.Subject = strSubj
    myOLItem.Attachments.Add fname, olByValue
    myOLItem.Recipients.Add strEmailAddr

    myOLItem.Send
    EmailFile = True
    
ExitProc:
    Set myOLItem = Nothing
    myOLApp.Quit
    Set myOLApp = Nothing
    
    Exit Function
    
EmailFileError:
    MsgBox Err.Number & "@" & Err.Description, vbOKOnly, "EmailFile"
    EmailFile = False
    Resume ExitProc
End Function



Replacing Bookmarks
(I think by replacing .Selection.Text you are overwriting the entire
bookmark, you need to put your text in .Range.Text)

Private Function UpdateTCFBookmarks(d As Word.Document, NewFileName as
string) As Boolean
Dim B As Word.Bookmark
On Error GoTo UpdateDocErr
 
    For Each B In d.Bookmarks
        DoEvents
        B.Range.Font.Name = "Arial"
        B.Range.Font.Size = 10
        B.Range.Bold = True
        
        ' each bookmark has a unique name, substitute the text from the db
        ' objTCF is a global object holding current record values...

        Select Case B.Name
            Case "bkDateSent": B.Range.Text = objTCF.DateAdded
            Case "bkClientName":  B.Range.Text = objTCF.CustomerName
            Case "bkAcctNum": B.Range.Text = objTCF.OrgAccountNumber & " - "
& objTCF.AccountType
            Case "bkTradeDate":  B.Range.Text = objTCF.TradeDate

' {list all bookmarks here} 

        End Select
    Next

 
    d.SaveAs NewFileName 
    UpdateTCFBookmarks = TRUE
    
    Exit Function
    
UpdateDocErr:
    MsgBox Err.Number & "@" & Err.Description, vbOKOnly, B.Name & " -
UpdateTCFBookmarks"
    UpdateTCFBookmarks = FALSE
End Function









-----Original Message-----
From: Nikola [mailto:Nikola@b...]
Sent: Wednesday, November 27, 2002 10:56 AM
To: Access
Subject: [access] save in Word and send as attachment


Hi all,

I create this code :

Private Sub cmbSendMail_Click()
On Error GoTo Err_cmbSendMail_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim objWord As Word.Application

    stDocName = "SendToWord"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

    Set objWord = CreateObject("Word.Application")
    With objWord
    .Visible = True
    .Documents.Open ("c:\_Radni\DFM\ForUSA\test.doc")
    .ActiveDocument.Bookmarks("Company").Select
    .Selection.Text = (CStr(Forms!SendToWord!Company))
    .ActiveDocument.Bookmarks("EmployeeID").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("VesselID").Select
    .Selection.Text = (CStr(Forms!SendToWord!VesselName))
    .ActiveDocument.Bookmarks("Date").Select
    .Selection.Text = (CStr(Forms!SendToWord!Date))
    .ActiveDocument.Bookmarks("OrderNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!OrderNo))
    .ActiveDocument.Bookmarks("PageNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!PageNo))
    .ActiveDocument.Bookmarks("Priority").Select
    .Selection.Text = (CStr(Forms!SendToWord!Status))
    .ActiveDocument.Bookmarks("EmployeeID1").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("DepartmentID").Select
    .Selection.Text = (CStr(Forms!SendToWord!Department))
    .ActiveDocument.Bookmarks("DirectPhone").Select
    .Selection.Text = (CStr(Forms!DirectLine!EmpName))
    .ActiveDocument.Bookmarks("EmailAddress").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmailAddress))


    End With

    objWord.ActiveDocument.Close
    objWord.Quit
    Set objWord = Nothing

Exit_cmbSendMail_Click:
    Exit Sub

Err_cmbSendMail_Click:
    If Err.Number = 94 Then
    objWord.Selection.Text = ""

    Else

    MsgBox Err.Number & vbCr & Err.Description

 End If

 Exit Sub

and I have two problems.First after sending form to Word all bookmark seting
are gone and second
how to send same test1.doc to outlook like attachmetn try Access. I have
half of code for open outlook with e-mail adress but i mess part for
attachment.


Code :

Private Sub cmdSendEmail_Click()
    Dim dbs As Database
    Dim rs As Recordset
    Dim strSql As String
    Dim strSubject, strMessage

    Set dbs = CurrentDb
    strSql = "SELECT * FROM Employees WHERE EmailCode = 1 "
    Set rs = dbs.OpenRecordset(strSql)

    strSubject = "Subject is - Test Access 97 email code"
    strMessage = "Meassage is - This is a customer message"

    Do Until rs.EOF
        DoCmd.SendObject acSendNoObject, , , rs!EmailAddress, , ,
strSubject, strMessage, True
        rs.MoveNext
    Loop
End Sub



Thanks,

Nikola

Message #3 by "Nikola" <Nikola@b...> on Wed, 27 Nov 2002 18:42:46 -0000

Sorry Dave but where i need to insert your function?

To create like new module and call from On event click?

I was try that. I copy your code and create new module "Test"

and I was try with Call test. but no luck can you explay me more about
code?


Thanks

-----Original Message-----
From: Carnley, Dave [mailto:dcarnley@a...]
Sent: Wednesday, November 27, 2002 3:27 PM
To: Access
Subject: [access] save in Word and send as attachment


I do both these things in one of my apps.  here is my code :)
This code is from VB6, but it should work OK in Access if you have the
Outlook and Word object libraries referenced:


Emailing Attached documents:

Private Function EmailFile(fname As String, strEmailAddr As String, strSubj
as string) As Boolean
Dim myOLApp As New Outlook.Application
Dim myOLItem As Outlook.MailItem

On Error GoTo EmailFileError

    Set myOLItem = myOLApp.CreateItem(olMailItem)
    myOLItem.Subject = strSubj
    myOLItem.Attachments.Add fname, olByValue
    myOLItem.Recipients.Add strEmailAddr

    myOLItem.Send
    EmailFile = True

ExitProc:
    Set myOLItem = Nothing
    myOLApp.Quit
    Set myOLApp = Nothing

    Exit Function

EmailFileError:
    MsgBox Err.Number & "@" & Err.Description, vbOKOnly, "EmailFile"
    EmailFile = False
    Resume ExitProc
End Function



Replacing Bookmarks
(I think by replacing .Selection.Text you are overwriting the entire
bookmark, you need to put your text in .Range.Text)

Private Function UpdateTCFBookmarks(d As Word.Document, NewFileName as
string) As Boolean
Dim B As Word.Bookmark
On Error GoTo UpdateDocErr

    For Each B In d.Bookmarks
        DoEvents
        B.Range.Font.Name = "Arial"
        B.Range.Font.Size = 10
        B.Range.Bold = True

        ' each bookmark has a unique name, substitute the text from the db
        ' objTCF is a global object holding current record values...

        Select Case B.Name
            Case "bkDateSent": B.Range.Text = objTCF.DateAdded
            Case "bkClientName":  B.Range.Text = objTCF.CustomerName
            Case "bkAcctNum": B.Range.Text = objTCF.OrgAccountNumber & " - "
& objTCF.AccountType
            Case "bkTradeDate":  B.Range.Text = objTCF.TradeDate

' {list all bookmarks here}

        End Select
    Next


    d.SaveAs NewFileName
    UpdateTCFBookmarks = TRUE

    Exit Function

UpdateDocErr:
    MsgBox Err.Number & "@" & Err.Description, vbOKOnly, B.Name & " -
UpdateTCFBookmarks"
    UpdateTCFBookmarks = FALSE
End Function









-----Original Message-----
From: Nikola [mailto:Nikola@b...]
Sent: Wednesday, November 27, 2002 10:56 AM
To: Access
Subject: [access] save in Word and send as attachment


Hi all,

I create this code :

Private Sub cmbSendMail_Click()
On Error GoTo Err_cmbSendMail_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim objWord As Word.Application

    stDocName = "SendToWord"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

    Set objWord = CreateObject("Word.Application")
    With objWord
    .Visible = True
    .Documents.Open ("c:\_Radni\DFM\ForUSA\test.doc")
    .ActiveDocument.Bookmarks("Company").Select
    .Selection.Text = (CStr(Forms!SendToWord!Company))
    .ActiveDocument.Bookmarks("EmployeeID").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("VesselID").Select
    .Selection.Text = (CStr(Forms!SendToWord!VesselName))
    .ActiveDocument.Bookmarks("Date").Select
    .Selection.Text = (CStr(Forms!SendToWord!Date))
    .ActiveDocument.Bookmarks("OrderNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!OrderNo))
    .ActiveDocument.Bookmarks("PageNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!PageNo))
    .ActiveDocument.Bookmarks("Priority").Select
    .Selection.Text = (CStr(Forms!SendToWord!Status))
    .ActiveDocument.Bookmarks("EmployeeID1").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("DepartmentID").Select
    .Selection.Text = (CStr(Forms!SendToWord!Department))
    .ActiveDocument.Bookmarks("DirectPhone").Select
    .Selection.Text = (CStr(Forms!DirectLine!EmpName))
    .ActiveDocument.Bookmarks("EmailAddress").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmailAddress))


    End With

    objWord.ActiveDocument.Close
    objWord.Quit
    Set objWord = Nothing

Exit_cmbSendMail_Click:
    Exit Sub

Err_cmbSendMail_Click:
    If Err.Number = 94 Then
    objWord.Selection.Text = ""

    Else

    MsgBox Err.Number & vbCr & Err.Description

 End If

 Exit Sub

and I have two problems.First after sending form to Word all bookmark seting
are gone and second
how to send same test1.doc to outlook like attachmetn try Access. I have
half of code for open outlook with e-mail adress but i mess part for
attachment.


Code :

Private Sub cmdSendEmail_Click()
    Dim dbs As Database
    Dim rs As Recordset
    Dim strSql As String
    Dim strSubject, strMessage

    Set dbs = CurrentDb
    strSql = "SELECT * FROM Employees WHERE EmailCode = 1 "
    Set rs = dbs.OpenRecordset(strSql)

    strSubject = "Subject is - Test Access 97 email code"
    strMessage = "Meassage is - This is a customer message"

    Do Until rs.EOF
        DoCmd.SendObject acSendNoObject, , , rs!EmailAddress, , ,
strSubject, strMessage, True
        rs.MoveNext
    Loop
End Sub



Thanks,

Nikola

Message #4 by "Carnley, Dave" <dcarnley@a...> on Wed, 27 Nov 2002 11:16:42 -0600

I was just showing you some example code so that you could enhance your own.
For example you could see how I replace the bookmark text and so fix your
bug of overwriting the entire bookmark, and also you can see how to email an
attachment file.  I didn't mean you should replace what you had...

-----Original Message-----
From: Nikola [mailto:Nikola@b...]
Sent: Wednesday, November 27, 2002 12:43 PM
To: Access
Subject: [access] RE: save in Word and send as attachment


Sorry Dave but where i need to insert your function?

To create like new module and call from On event click?

I was try that. I copy your code and create new module "Test"

and I was try with Call test. but no luck can you explay me more about
code?


Thanks

-----Original Message-----
From: Carnley, Dave [mailto:dcarnley@a...]
Sent: Wednesday, November 27, 2002 3:27 PM
To: Access
Subject: [access] save in Word and send as attachment


I do both these things in one of my apps.  here is my code :)
This code is from VB6, but it should work OK in Access if you have the
Outlook and Word object libraries referenced:


Emailing Attached documents:

Private Function EmailFile(fname As String, strEmailAddr As String, strSubj
as string) As Boolean
Dim myOLApp As New Outlook.Application
Dim myOLItem As Outlook.MailItem

On Error GoTo EmailFileError

    Set myOLItem = myOLApp.CreateItem(olMailItem)
    myOLItem.Subject = strSubj
    myOLItem.Attachments.Add fname, olByValue
    myOLItem.Recipients.Add strEmailAddr

    myOLItem.Send
    EmailFile = True

ExitProc:
    Set myOLItem = Nothing
    myOLApp.Quit
    Set myOLApp = Nothing

    Exit Function

EmailFileError:
    MsgBox Err.Number & "@" & Err.Description, vbOKOnly, "EmailFile"
    EmailFile = False
    Resume ExitProc
End Function



Replacing Bookmarks
(I think by replacing .Selection.Text you are overwriting the entire
bookmark, you need to put your text in .Range.Text)

Private Function UpdateTCFBookmarks(d As Word.Document, NewFileName as
string) As Boolean
Dim B As Word.Bookmark
On Error GoTo UpdateDocErr

    For Each B In d.Bookmarks
        DoEvents
        B.Range.Font.Name = "Arial"
        B.Range.Font.Size = 10
        B.Range.Bold = True

        ' each bookmark has a unique name, substitute the text from the db
        ' objTCF is a global object holding current record values...

        Select Case B.Name
            Case "bkDateSent": B.Range.Text = objTCF.DateAdded
            Case "bkClientName":  B.Range.Text = objTCF.CustomerName
            Case "bkAcctNum": B.Range.Text = objTCF.OrgAccountNumber & " - "
& objTCF.AccountType
            Case "bkTradeDate":  B.Range.Text = objTCF.TradeDate

' {list all bookmarks here}

        End Select
    Next


    d.SaveAs NewFileName
    UpdateTCFBookmarks = TRUE

    Exit Function

UpdateDocErr:
    MsgBox Err.Number & "@" & Err.Description, vbOKOnly, B.Name & " -
UpdateTCFBookmarks"
    UpdateTCFBookmarks = FALSE
End Function









-----Original Message-----
From: Nikola [mailto:Nikola@b...]
Sent: Wednesday, November 27, 2002 10:56 AM
To: Access
Subject: [access] save in Word and send as attachment


Hi all,

I create this code :

Private Sub cmbSendMail_Click()
On Error GoTo Err_cmbSendMail_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim objWord As Word.Application

    stDocName = "SendToWord"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

    Set objWord = CreateObject("Word.Application")
    With objWord
    .Visible = True
    .Documents.Open ("c:\_Radni\DFM\ForUSA\test.doc")
    .ActiveDocument.Bookmarks("Company").Select
    .Selection.Text = (CStr(Forms!SendToWord!Company))
    .ActiveDocument.Bookmarks("EmployeeID").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("VesselID").Select
    .Selection.Text = (CStr(Forms!SendToWord!VesselName))
    .ActiveDocument.Bookmarks("Date").Select
    .Selection.Text = (CStr(Forms!SendToWord!Date))
    .ActiveDocument.Bookmarks("OrderNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!OrderNo))
    .ActiveDocument.Bookmarks("PageNo").Select
    .Selection.Text = (CStr(Forms!SendToWord!PageNo))
    .ActiveDocument.Bookmarks("Priority").Select
    .Selection.Text = (CStr(Forms!SendToWord!Status))
    .ActiveDocument.Bookmarks("EmployeeID1").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmpName))
    .ActiveDocument.Bookmarks("DepartmentID").Select
    .Selection.Text = (CStr(Forms!SendToWord!Department))
    .ActiveDocument.Bookmarks("DirectPhone").Select
    .Selection.Text = (CStr(Forms!DirectLine!EmpName))
    .ActiveDocument.Bookmarks("EmailAddress").Select
    .Selection.Text = (CStr(Forms!SendToWord!EmailAddress))


    End With

    objWord.ActiveDocument.Close
    objWord.Quit
    Set objWord = Nothing

Exit_cmbSendMail_Click:
    Exit Sub

Err_cmbSendMail_Click:
    If Err.Number = 94 Then
    objWord.Selection.Text = ""

    Else

    MsgBox Err.Number & vbCr & Err.Description

 End If

 Exit Sub

and I have two problems.First after sending form to Word all bookmark seting
are gone and second
how to send same test1.doc to outlook like attachmetn try Access. I have
half of code for open outlook with e-mail adress but i mess part for
attachment.


Code :

Private Sub cmdSendEmail_Click()
    Dim dbs As Database
    Dim rs As Recordset
    Dim strSql As String
    Dim strSubject, strMessage

    Set dbs = CurrentDb
    strSql = "SELECT * FROM Employees WHERE EmailCode = 1 "
    Set rs = dbs.OpenRecordset(strSql)

    strSubject = "Subject is - Test Access 97 email code"
    strMessage = "Meassage is - This is a customer message"

    Do Until rs.EOF
        DoCmd.SendObject acSendNoObject, , , rs!EmailAddress, , ,
strSubject, strMessage, True
        rs.MoveNext
    Loop
End Sub



Thanks,

Nikola

Return to Index

P2P Archives