• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3374
  • Last Modified:

Microsoft Access 2003 Run time Error 429 Activex Component Can't create Object

This code was working on Access 2000 I updated to 2003 and it does no longer work
i get the error "Run time Error 429 Activex Component Can't create Object" and I can't find the cause.

I already wen't through Microsoft KB
and no luck.

All my references are working OK and the 5 causes mentioned in the article  do nothing to solve my problem.

the error is in th e line 306 of the code
' Procedure : cmFedexClaim_Click
' Author    : javier.silva
' Date      : 11/26/2008
' Purpose   :
Private Sub cmFedexClaim_Click()
Const cDocumentTemplate = "C:\temporal\fedexClaim.doc"
Dim toContact As String
Dim ToCompany As String
Dim toAddress As String
Dim ToCity As String
Dim toState As String
Dim ToCountry As String
Dim ToZIP As String
Dim toPhone As String
Dim toFax As String
Dim toEmail As String
Dim Tracking As String
Dim ShipDate As String
Dim NoPackages As String
Dim Weight As String
Dim FedexControlNumber As String
Dim NoPackages1 As String
Dim ItemNo1 As String
Dim Description1 As String
Dim ClaimedAmount1 As String
Dim NoPackages2 As String
Dim ItemNo2 As String
Dim Description2 As String
Dim ClaimedAmount2 As String
Dim NoPackages3 As String
Dim ItemNo3 As String
Dim Description3 As String
Dim ClaimedAmount3 As String
Dim ContentsOfShipment As String
Dim DamageOuter1 As String
Dim DamageOuter2 As String
Dim DamageOuter3 As String
Dim DamageInner1 As String
Dim DamageInner2 As String
Dim DamageInner3 As String
Dim DamageContents1 As String
Dim DamageContents2 As String
Dim DamageContents3 As String
Dim DeclaredValue As String
Dim DeclaredValueCustoms As String
Dim MerchandiseValue As String
Dim FedexPackFee As String
Dim FreightCharge As String
Dim TotalClaim As String
Dim Remarks1 As String
Dim Remarks2 As String
Dim SalvageContact As String
Const SalvagePhone = "(760) 275-0709"
Const SalvageFax = "(732) 216-9351"
Dim InternalReference As String
Dim ClaimDate As String
Dim numTotalClaim As Double
    Dim ckLoss As Boolean
    Dim ckComplete As Boolean
    Dim ckPartial As Boolean
    Dim ckDamaged As Boolean
    Dim CurrentBooking As Integer
    Dim txPONumber As String
    Dim txNoPackages(4) As String
    Dim txItemNo(4) As String
    Dim txClaimedAmount(5) As String
    Dim txDescription(3) As String
    Dim sSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim POExist As Boolean
    Dim i As Integer
    Dim Counter As Integer
    Dim appWord As Object
'************* Get Phone Number data
   On Error GoTo cmFedexClaim_Click_Error
    sSql = "CustomerID = " & Me.CustomerID
        If IsNull(DLookup("[ContactFirstName]", "tblCustomers", sSql)) Then
            toContact = "Receiving Department"
            toContact = (DLookup("[ContactFirstName]", "tblCustomers", sSql))
        End If
        If IsNull(DLookup("[CompanyName]", "tblCustomers", sSql)) Then
            ToCompany = "Cardinal Health "
            ToCompany = (DLookup("[CompanyName]", "tblCustomers", sSql))
        End If
        If IsNull(DLookup("[BillingAddress]", "tblCustomers", sSql)) Then
            toAddress = "Address N/A"
            toAddress = (DLookup("[BillingAddress]", "tblCustomers", sSql))
        End If
        If IsNull(DLookup("[City]", "tblCustomers", sSql)) Then
            ToCity = "Address N/A"
            ToCity = (DLookup("[City]", "tblCustomers", sSql))
        End If
        If IsNull(DLookup("[StateOrProvince]", "tblCustomers", sSql)) Then
            toState = "N/A"
            toState = (DLookup("[StateOrProvince]", "tblCustomers", sSql))
        End If
       If IsNull(DLookup("[Country/Region]", "tblCustomers", sSql)) Then
            ToCountry = "N/A"
            ToCountry = (DLookup("[Country/Region]", "tblCustomers", sSql))
        End If
       If IsNull(DLookup("[PostalCode]", "tblCustomers", sSql)) Then
            ToZIP = "N/A"
            ToZIP = (DLookup("[PostalCode]", "tblCustomers", sSql))
        End If
        If IsNull(DLookup("[PhoneNumber]", "tblCustomers", sSql)) Then
            toPhone = "N/A"
            toPhone = (DLookup("[PhoneNumber]", "tblCustomers", sSql))
        End If
        If IsNull(DLookup("[FaxNumber]", "tblCustomers", sSql)) Then
            toFax = "N/A"
            toFax = (DLookup("[FaxNumber]", "tblCustomers", sSql))
        End If
        If IsNull(DLookup("[EmailAddress]", "tblCustomers", sSql)) Then
            toEmail = "N/A"
            toEmail = (DLookup("[EmailAddress]", "tblCustomers", sSql))
        End If
        Tracking = Me.Trailer
        txPONumber = Trim(Me.PO)
    sSql = "r3ponumber= " & """" & txPONumber & """"
        If IsNull(DLookup("[BookingID]", "tblOrdersByBooking", sSql)) Then
            CurrentBooking = 0
            CurrentBooking = (DLookup("[BookingID]", "tblOrdersByBooking", sSql))
        End If
   sSql = "BookingID= " & CurrentBooking
        If IsNull(DLookup("[DateShip]", "tblShipments", sSql)) Then
            ShipDate = 0
            ShipDate = (DLookup("[DateShip]", "tblShipments", sSql))
        End If
sSql = "RGA = " & """" & Me.RGA & """"
        If IsNull(DLookup("[qtyrga]", "qryRGADetailSummary", sSql)) Then
            NoPackages = "N/A"
            NoPackages = (DLookup("[qtyrga]", "qryRGADetailSummary", sSql))
        End If
        If IsNull(DLookup("[TotalWeight]", "qryRGADetailSummary", sSql)) Then
            Weight = "N/A"
            Weight = (DLookup("[TotalWeight]", "qryRGADetailSummary", sSql))
            Weight = Weight & " Lbs"
        End If
       FedexControlNumber = Me.Trailer
'************* Get packages item number description and claimed ammount
    For i = 1 To 3
        txNoPackages(i) = ""
        txItemNo(i) = ""
        txDescription(i) = ""
        txClaimedAmount(i) = ""
        Next i
        DeclaredValue = ""
    sSql = "SELECT Code, DESCRIPTION, QTYRGA, ExtCost FROM qryRGADetails"
    sSql = sSql & " where RGA =" & """" & Me.RGA & """"
            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset(sSql, dbOpenDynaset, [dbSeeChanges])
    numTotalClaim = 0
    If rst.RecordCount = 0 Then
            GoTo ArrancarWord
              Counter = (rst.RecordCount)
        If Counter <= 3 Then Counter = Counter Else Counter = 3
    i = 1
               While ((Not rst.EOF) And (i < 4))
        txItemNo(i) = (rst!Code)
        txDescription(i) = (rst!Description)
        txClaimedAmount(i) = (rst!ExtCost)
        numTotalClaim = numTotalClaim + Val(txClaimedAmount(i))
        DeclaredValue = DeclaredValue + txClaimedAmount(i)
               txClaimedAmount(i) = Format(txClaimedAmount(i), "$##,##0.00")
            txNoPackages(i) = (rst!QTYRGA)
                        If txNoPackages(i) = "0" Then txNoPackages(i) = "1"
                        If txNoPackages(i) = "1" Then
                                txNoPackages(i) = txNoPackages(i) & " CS"
                                txNoPackages(i) = txNoPackages(i) & " CS"
                        End If
                        i = i + 1
    NoPackages1 = txNoPackages(1)
    ItemNo1 = txItemNo(1)
    Description1 = txDescription(1)
    ClaimedAmount1 = txClaimedAmount(1)
    NoPackages2 = txNoPackages(2)
    ItemNo2 = txItemNo(2)
    Description2 = txDescription(2)
    ClaimedAmount2 = txClaimedAmount(2)
    NoPackages3 = txNoPackages(3)
    ItemNo3 = txItemNo(3)
    Description3 = txDescription(3)
    ClaimedAmount3 = txClaimedAmount(3)
            End If
    ContentsOfShipment = " Plastic Tubing / Medical Devices"
    DamageOuter1 = "Damages Described in detail in Attached RGA sent to customer"
    DamageInner1 = "Damages Described in detail in Attached RGA sent to customer"
    DamageContents1 = "Damages Described in detail in Attached RGA sent to customer"
    'numTotalClaim = DeclaredValue
    DeclaredValue = "$" & " " & numTotalClaim
    DeclaredValue = Format(DeclaredValue, "$##,##0.00")
    DeclaredValueCustoms = "N/A"
    MerchandiseValue = DeclaredValue
    FedexPackFee = "$ 0.00"
    FreightCharge = "$ 150.00"
    numTotalClaim = numTotalClaim + 150
    TotalClaim = numTotalClaim
    TotalClaim = Format(TotalClaim, "$##,##0.00")
    InternalReference = Me.RGA
    ClaimDate = Me.DateCreation
    SalvageContact = "Not Applicable"
    ckLoss = True
    ckComplete = False
    ckPartial = True
    ckDamaged = False
'############## START WORKING WITH WORD  ######################
On Error Resume Next
    ' 1. Get Word up and running
    Set appWord = GetObject(, "Word.Application")
    If Err Then
        Set appWord = CreateObject("Word.Application")
        If Err Then
            MsgBox "Can't start Word!"
            Exit Sub
        End If
        appWord.Visible = True
    End If
On Error GoTo cmFedexClaim_Click_Error
    ' 2. Create new review document
    With appWord.Documents.Add(Template:=cDocumentTemplate)
        ' 3. Fill formfields...
.FormFields("toContact").Result = toContact
.FormFields("toCompany").Result = ToCompany
.FormFields("toAddress").Result = toAddress
.FormFields("toCity").Result = ToCity
.FormFields("toState").Result = toState
.FormFields("toCountry").Result = ToCountry
.FormFields("toZip").Result = ToZIP
.FormFields("toPhone").Result = toPhone
.FormFields("toFax").Result = toFax
.FormFields("toEmail").Result = toEmail
.FormFields("Tracking").Result = Tracking
.FormFields("ShipDate").Result = ShipDate
.FormFields("NoPackages").Result = NoPackages
.FormFields("Weight").Result = Weight
.FormFields("FedexControlNumber").Result = FedexControlNumber
.FormFields("NoPackages1").Result = NoPackages1
.FormFields("ItemNo1").Result = ItemNo1
.FormFields("Description1").Result = Description1
.FormFields("ClaimedAmount1").Result = ClaimedAmount1
.FormFields("NoPackages2").Result = NoPackages2
.FormFields("ItemNo2").Result = ItemNo2
.FormFields("Description2").Result = Description2
.FormFields("ClaimedAmount2").Result = ClaimedAmount2
.FormFields("NoPackages3").Result = NoPackages3
.FormFields("ItemNo3").Result = ItemNo3
.FormFields("Description3").Result = Description3
.FormFields("ClaimedAmount3").Result = ClaimedAmount3
.FormFields("ContentsOfShipment").Result = ContentsOfShipment
.FormFields("DamageOuter1").Result = DamageOuter1
.FormFields("DamageOuter2").Result = DamageOuter2
.FormFields("DamageOuter3").Result = DamageOuter3
.FormFields("DamageInner1").Result = DamageInner1
.FormFields("DamageInner2").Result = DamageInner2
.FormFields("DamageInner3").Result = DamageInner3
.FormFields("DamageContents1").Result = DamageContents1
.FormFields("DamageContents2").Result = DamageContents2
.FormFields("DamageContents3").Result = DamageContents3
.FormFields("DeclaredValue").Result = DeclaredValue
.FormFields("DeclaredValueCustoms").Result = DeclaredValueCustoms
.FormFields("MerchandiseValue").Result = MerchandiseValue
.FormFields("FedexPackFee").Result = FedexPackFee
.FormFields("FreightCharge").Result = FreightCharge
.FormFields("TotalClaim").Result = TotalClaim
.FormFields("Remarks1").Result = Remarks1
.FormFields("Remarks2").Result = Remarks2
.FormFields("SalvageContact").Result = SalvageContact
.FormFields("SalvagePhone").Result = SalvagePhone
.FormFields("Date").Result = ClaimDate
.FormFields("SalvageFax").Result = SalvageFax
.FormFields("InternalReference").Result = InternalReference
.FormFields("ckLoss").CheckBox.Value = ckLoss
.FormFields("ckComplete").CheckBox.Value = ckComplete
.FormFields("ckPartial").CheckBox.Value = ckPartial
.FormFields("ckDamaged").CheckBox.Value = ckDamaged
        ' allow closing without saving
        .Saved = True
    End With
    Exit Sub
   On Error GoTo 0
   Exit Sub
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmFedexClaim_Click of VBA Document Form_frmRGAHeader"
End Sub
Private Sub Command183_Click()
On Error GoTo Err_Command183_Click
Dim stWhere As String
Dim stDocName As String
  rptCaption = Me.RGA
    stDocName = "rptRGA"
    stWhere = "([RGAID]=" & Me.RGAID & ")"
    'DoCmd.OpenReport "rptEmbarquesMensual",
    DoCmd.OpenReport stDocName, acViewPreview, , stWhere
'     DoCmd.Maximize
 '   DoCmd.RunCommand acCmdFitToWindow
    Exit Sub
    MsgBox Err.Description
    Resume Exit_Command183_Click
End Sub

Open in new window

  • 7
  • 4
  • 3
  • +1
1 Solution
Chris BottomleyCommented:
Hello TOPIO,

I would initially assume you haven't included the references for DAO.  Two options leave as they are add the DAO object library reference, (in the VBE tools | references and navigate to microsoft DAO ...) reference:

2. Modify the definitions to use late binding:

Dim dbs As object
Dim rst As Object

is word actually installed (properly) on that machine?
if so try running word first.
Chris BottomleyCommented:

First off I didn't read the full post so my apologies.

Secondly I cannot see anything obvious, line 306 as posted is blank so is there anything on that line that is erroneous ... try deleting the blanks and how does that affect the reported line?

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

also in the vb editor window goto tools options and make sure it only breaks on unhandled errors..
since there's a "On Error Resume Next" on line 300
oops tools>options and then the general tab
this is what i think should solve your problem.
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
I'm with Surone1 on this - is Word properly installed on the machine?
TOPIOAuthor Commented:
The references to DAO arre correct, tracing the variables all the data lookups are correct, the reference is shown below the problem is in line 307 when I call word. (not in 306 aas I had posted)
Please see below

Surone1>> yes word is installed correctly in my machine the office installation has been recently refreshed. and the options are set as you mentioned
Please see below

it says break on all errors in yours, that's the problem.. please see my jpg
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Perhaps try this:

   Set appWord = GetObject("", "Word.Application")

From the Help file:

If pathname is a zero-length string (""), GetObject returns a new object instance of the specified type. If the pathname argument is omitted, GetObject returns a currently active object of the specified type. If no object of the specified type exists, an error occurs.
TOPIOAuthor Commented:

Surone1>>  Sorry, I forgot to mention that I changed my options as seen above from what you can see in the picture to what you mentioned in your post, but on doing so the code takes  45 seconds to run and then I get another error
TOPIOAuthor Commented:
The word application by itself runs smoothly and the template document called fedex.doc opens without a hitch and can be edited, so I do not know what else to do
Chris BottomleyCommented:
Your calls to set appword are as you know correct, try deleting a couple of lines and retype the code ... no copy paste in case there any control characters caught up therein.

Chris BottomleyCommented:
Lines 306 and 307 in particular of course!

ok set breakpoints around line 319 and below tell us where it gives the error:

On Error GoTo cmFedexClaim_Click_Error
    ' 2. Create new review document
    With appWord.Documents.Add(Template:=cDocumentTemplate)

Featured Post

Transaction-level recovery for Oracle database

Veeam Explore for Oracle delivers low RTOs and RPOs with agentless transaction log backup and transaction-level recovery of Oracle databases. You can restore the database to a precise point in time, even to a specific transaction.

  • 7
  • 4
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now