+ Reply to Thread
Results 1 to 1 of 1

Inserting Text Box in Word Doc from excel

Hybrid View

  1. #1
    Registered User
    Join Date
    05-22-2012
    Location
    India
    MS-Off Ver
    Excel 2010
    Posts
    12

    Inserting Text Box in Word Doc from excel

    Dear Team,

    Hope you are doing great.

    I have 1 requirement where i need to prepare word doc letter and send to all finance manager through outlook as attachment.

    I have written macro code for the same which is working fine but i have additional requirement in this code is where supplier Name and address should come in "Text Box" as shown below and not typed as normal which should come after To Finance Manager .

    To Finance Manager,
    «Supplier_Name»
    «Supplier_Address»

    Dear Sir/Madam

    We regret that we are unable to process the below referred invoice for the following reason:

    «Rejection_Reason»


    Accenture Ref: «URN»

    Invoice Number: «Invoice_Number»

    Invoice Date: «Invoice_Date»

    Invoice Amount: «Invoice_Amount»«Currency_code»


    Correct Details:

    «Last_Comment»


    Request you to kindly amend your invoice accordingly and resend it to us at
    «DFM_Email_id» as soon as possible.

    If you have any queries please do not hesitate to contact customer support at
    «Customer_care».

    Yours sincerely
    Below is the VBA code i have written which is working fine except the Name and address not coming in TextBox.

    Private Sub CommandButton1_Click()
    Dim msg As String
    Dim filename As String
    Dim r As Integer
    Dim lrow As Long
    Dim wrdapp As Word.Application
    Dim wrddoc As Word.Document
    Dim strAddressData As String
    Dim objShape As Shape
    
    lrow = Worksheets("sheet1").Range("a" & Rows.Count).End(xlUp).Row
    For r = 3 To lrow
    Set wrdapp = CreateObject("word.application")
    wrdapp.Visible = True
    Set wrddoc = wrdapp.Documents.Open("C:\Rejection\document1.docx")
    
    With wrddoc
    msg = ""
    msg = msg & "To Finance Manager" & "," & vbCrLf
    
    'msg = msg & ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 2.5, 1.5, _
    116, 145).TextFrame.TextRange.Text = "Daniel" 'Worksheets("sheet1").Range("W" & r) & vbCrLf & vbCrLf & vbCrLf
    
    msg = msg & "Dear Sir/Madam" & "," & vbCrLf & vbCrLf
    msg = msg & "We regret that we are unable to process the below referred invoice for the following reason:" & " " & Worksheets("sheet1").Range("P" & r) & vbCrLf & vbCrLf
    
    msg = msg & "Accenture Ref - " & Worksheets("sheet1").Range("A" & r) & vbCrLf
    msg = msg & "Invoice Number - " & Worksheets("sheet1").Range("H" & r) & vbCrLf
    msg = msg & "Invoice Date - " & Worksheets("sheet1").Range("I" & r) & vbCrLf
    msg = msg & "Invoice Amount - " & Worksheets("sheet1").Range("J" & r) & "" & Worksheets("sheet1").Range("K" & r) & vbCrLf & vbCrLf & vbCrLf
    
    msg = msg & "Correct Details" & vbCrLf
    msg = msg & Worksheets("sheet1").Range("N" & r) & vbCrLf & vbCrLf & vbCrLf
    
    msg = msg & "Request you to kindly amend your invoice accordingly and resend it to us at" & " " & Worksheets("sheet1").Range("V" & r) & "as soon as possible" & vbCrLf & vbCrLf
    msg = msg & "If you have any queries please do not hesitate to contact customer support at" & " " & Worksheets("sheet1").Range("U" & r) & vbCrLf & vbCrLf & vbCrLf
    msg = msg & "Yours sincerely" & vbCrLf & "Accenture Business Services."
    
    .Content.InsertAfter msg
    .Content.InsertParagraphAfter
    
    filename = Worksheets("sheet1").Range("AA" & r)
    'If Dir("C:\Rejection\filename.doc") <> "" Then
    ' Kill "C:\Foldername\filename.doc"
    ' End If
    .SaveAs ("c:\Rejection\" & filename)
    .Close
    End With
    ' Sending Mails from Outlook
    Dim olf As Outlook.MAPIFolder, olmailitem As Outlook.MailItem
    Dim tocontact As Outlook.Recipient
    Set olf = GetObject("", _
    "outlook.application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set olmailitem = olf.Items.Add
    With olmailitem
    .Subject = filename
    Set tocontact = .Recipients.Add(Worksheets("sheet1").Range("X" & r))
    Set tocontact = .Recipients.Add(Worksheets("sheet1").Range("Y" & r))
    tocontact.Type = olCC
    Set tocontact = .Recipients.Add(Worksheets("sheet1").Range("Z" & r))
    Set tocontact = .Recipients.Add(Worksheets("sheet1").Range("Z" & r))
    .body = "This is the Message text"
    .Attachments.Add "c:\Rejection\" & filename & ".docx", olByValue, , _
    Attachment
    
    .OriginatorDeliveryReportRequested = True
    .ReadReceiptRequested = True
    .Save
    .Send
    End With
    
    Next r
    
    wrdapp.Quit
    Set wrddoc = Nothing
    Set wrdapp = Nothing
    
    Set tocontact = Nothing
    Set olmailitem = Nothing
    Set olf = Nothing
    
    End Sub
    Please help me with VBA code i should put to have Name and address in Text Box in Word Document.

    Thanks
    Last edited by Paul; 05-23-2012 at 03:07 AM. Reason: Added CODE tags for new user, and moved thread to a proper forum. Please read the forum rules before posting again.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1