VBA code to transfer data from Excel to Word Misses out "4" when transfering data

[mbuk320000]

i have a VBA code set up to transfer cell values to a word document but it always miss any 4 ie in excel one cell i have "Royal Mail 48 Small Parcel" but when it transfer to the word document its "Royal Mail 8 Small Parcel"

vba Code



Option Explicit



Sub shipping()

Dim CustRow, CustCol, LastRow, TemplRow, DaysSince, FrDays, ToDays As Long

Dim DocLoc, TagName, TagValue, TemplName, FileName As String

Dim CurDt, LastAppDt As Date

Dim WordDoc, WordApp, OutApp, OutMail As Object

Dim wordcontent As Word.Range

With Sheet28



  If .Range("M1").Value = Empty Then

    MsgBox "Please select a correct template from the drop down list"

    .Range("M1").Select

    Exit Sub

  End If

    TemplRow = .Range("M2").Value 'Set Template Row

    TemplName = .Range("M1").Value 'Set Template Name

    DaysSince = .Range("U1").Value



    DocLoc = Sheet29.Range("C4").Value





    'Open Word Template

    On Error Resume Next 'If Word is already running

    Set WordApp = GetObject("Word.Application")

    If Err.Number <> 0 Then

    'Launch a new instance of Word

    Err.Clear

    'On Error GoTo Error_Handler

    Set WordApp = CreateObject("Word.Application")

    WordApp.Visible = True 'Make the application visible to the user

    End If





    LastRow = .Range("A9999").End(xlUp).Row  'Determine Last Row in Table

        For CustRow = 3 To LastRow

        If DaysSince = .Range("j" & CustRow).Value Then

                                Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template

                                For CustCol = 1 To 14 'Move Through 10 Columns

                                    TagName = .Cells(2, CustCol).Value 'Tag Name

                                    TagValue = .Cells(CustRow, CustCol).Value 'Tag Value

                                     With WordDoc.Content.Find

                                        .Text = TagName

                                        .Replacement.Text = TagValue

                                        .Wrap = wdfindcontinue

                                        .Execute Replace:=wdReplaceAll 'Find & Replace all instances

                                     End With

                                     .Range("j" & CustRow).Value = Now

                                     .Range("k" & CustRow).Value = TemplName 'Template Name

                                Next CustCol

                                End If





                        If .Range("N1").Value = "PDF" Then

                                       FileName = "\\drobo\documents\P0188 - The Body Shop At Home\14 - Shiping to Clients\02 - Tracking Letters\" & .Range("D" & CustRow).Value & "_" & "Tracking" & "_" & .Range("b" & CustRow).Value & ".pdf" 'Create full filename & Path with current workbook location, Last Name & First Name

                                       WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF

                                       WordDoc.Close False

                                   Else: 'If Word

                                       FileName = "\\drobo\documents\P0188 - The Body Shop At Home\14 - Shiping to Clients\02 - Tracking Letters\" & .Range("D" & CustRow).Value & "_" & "Tracking" & "_" & .Range("b" & CustRow).Value & ".docx"

                                       WordDoc.SaveAs FileName

                                   End If

         If .Range("P1").Value = "Email" Then



                                                  Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application

                                                  Set OutMail = OutApp.CreateItem(0) 'Create Email

                                                  With OutMail

                                                      .To = Sheet28.Range("f" & CustRow).Value

                                                      .Subject = "Hi, " & Sheet28.Range("d" & CustRow).Value & "  your Tracking Details"

                                                      .Body = "Hello, " & Sheet28.Range("d" & CustRow).Value & " Thank You for your orded . Please see the attached file"

                                                      .Attachments.Add FileName

                                                      .Display 'To send without Displaying change .Display to .Send

                                                  End With

                                   End If





also have an issue with the email option as well





                                           WordDoc.Close







        Next CustRow

        WordApp.Quit

End With

End Sub

 

[NdNoviceHlp]

Hi mbuk. It's very odd your difficulty as you have stated it. You haven't indicated how the Royal Mail 48 etc. string is generated? I would suggest that your difficulties arise from your inaccurate variable declarations. For example...

Dim DocLoc, TagName, TagValue, TemplName, FileName As String

only declares FileName as a string. The rest of the undeclared variables are by default Variant so XL just does whatever it thinks is best. Only strings can be transferred to Word documents, so I'm guessing XL has supposed wrong. Trial correcting all of your variable declarations. For example....

Dim DocLoc As String, TagName As String, TagValue As String, TemplName As String, FileName As String

HTH. Dave

 

[mbuk320000]

finally found the issue because I had "For CustCol = 1 To 14" due to having data in cell M2 (the number 4) every time there was a number 4 on the word document it would replace it with what data was in m column as this was empty it deleted the number 3 so I changed "custcol= 1 to 13" hopefully this helps anyone with the same issues