Results 1 to 10 of 10

Automation Error

Threaded View

  1. #1
    Registered User
    Join Date
    03-08-2005
    Posts
    16

    Automation Error

    Hi all, I'm getting an automation error, but the confusing part is that my code had been working fine. I made a change and got the error. I removed the change, but the error has remained. I went back to a previous version of the file, which never had the change, and I get the error. I'm starting to wonder if I broke Excel...lol. Just to be safe, I did verify that a few other of my macros work, and they do.

    Moderator's Note:
    Cross Post: http://www.mrexcel.com/forum/excel-q...ion-error.html

    The line of code that it is giving the error on is:
    With WordApp
        .ActiveDocument.SaveAs Filename:=SaveAsName
        .ActiveWindow.Close
        ' Kill the Object
        .Quit
    End With
    (on .Quit)

    Here is the code for the sheet:
    Sub AddData1()
    
    '   Creates Word document
    Dim WordApp As Object
    Dim LastRow As Integer, i As Integer, r As Integer, Records As Integer
     
    'On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
     
    'data sort -- will need for For/i loop to begin after this statement
    
    ' Cycle through all records on Sheet1
    Records = ActiveSheet.UsedRange.Rows.Count - 1
    For i = 1 To Records
    
    '   Start Word And create an Object
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        .Documents.Add
    End With
     
    '   Determine the file name
    SaveAsName = ThisWorkbook.Path & "\" & "Test-" & i & ".docx" 'replace with applicant/city/state
    
    
    ' Information from worksheet
    Set Data = Sheets("Sheet1").Range("A2")
     
    
        ' Update status bar progress message
        oldStatusBar = Application.DisplayStatusBar
        Application.DisplayStatusBar = True
        Application.StatusBar = "Processing Record " & i & " of " & Records
         
        ' Assign current data To variables
        APPLICANT = Data.Offset(i - 1, 0).Value 'letter
        CITY = Data.Offset(i - 1, 1).Value 'number
        State = UCase(Data.Offset(i - 1, 2).Value) 'title
        'Descript = Data.Offset(i - 1, 3).Value
        'FMV = Format(Data.Offset(i - 1, 4).Value, "#,000")
        'FMText = Data.Offset(i - 1, 5).Value
        'Donor = Data.Offset(i - 1, 6).Value
         
        ' Send commands To Word
        With WordApp
            With .Selection
                With .PageSetup
                    .LineNumbering.Active = False
                    .Orientation = wdOrientPortrait
                    .TopMargin = InchesToPoints(0.5)
                    .BottomMargin = InchesToPoints(0.5)
                    .LeftMargin = InchesToPoints(0.5)
                    .RightMargin = InchesToPoints(0.5)
                    .Gutter = InchesToPoints(0)
                    .HeaderDistance = InchesToPoints(0.5)
                    .FooterDistance = InchesToPoints(0.5)
                    .PageWidth = InchesToPoints(8.5)
                    .PageHeight = InchesToPoints(11)
                    .FirstPageTray = wdPrinterDefaultBin
                    .OtherPagesTray = wdPrinterDefaultBin
                    .SectionStart = wdSectionNewPage
                    .OddAndEvenPagesHeaderFooter = False
                    .DifferentFirstPageHeaderFooter = False
                    .VerticalAlignment = wdAlignVerticalTop
                    .SuppressEndnotes = False
                    .MirrorMargins = False
                    .TwoPagesOnOne = False
                    .BookFoldPrinting = False
                    .BookFoldRevPrinting = False
                    .BookFoldPrintingSheets = 1
                    .GutterPos = wdGutterPosLeft
                End With
                
                'Name, address, contact
                .ParagraphFormat.Alignment = 2
                .Font.Name = "Times New Roman"
                .Font.Size = 14
                .Font.Bold = True
                .TypeText Text:="Name" & Chr(11)
                .Font.Size = 12
                .Font.Bold = False
                .TypeText Text:="Address" & Chr(11)
                .TypeText Text:="City, State Zip" & Chr(11)
                .TypeText Text:="Phone" & Chr(11)
                .TypeText Text:="Email: "
                .Hyperlinks.Add Anchor:=.Range, _
                Address:="http://cnn.com", _
                ScreenTip:="cnn.com", _
                TextToDisplay:="cnn.com"
                
                'horizontal line
                .TypeParagraph
                With .ParagraphFormat
                    .Alignment = 0
                    With .Borders(wdBorderTop)
                        .LineStyle = wdLineStyleThinThickSmallGap
                        .LineWidth = wdLineWidth300pt
                        .Color = wdColorAutomatic
                    End With
                    With .Borders
                        .DistanceFromTop = 1
                        .DistanceFromLeft = 4
                        .DistanceFromBottom = 1
                        .DistanceFromRight = 4
                        .Shadow = False
                    End With
                End With
                
                'date
                .TypeText Text:=Chr(11) & Format(Date, "mmmm d, yyyy") & Chr(11)
                
                'title
                .TypeParagraph
                .ParagraphFormat.Alignment = 1
                .Font.Size = 18
                .Font.Bold = True
                .Font.Underline = True
                .TypeText Text:="Document Title"
                .Font.Size = 12
                .Font.Bold = False
                .Font.Underline = False
                
                'body
                .TypeParagraph
                .ParagraphFormat.Alignment = 0
                .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
                .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
                .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
                
                'data
                .TypeParagraph
                .TypeText Text:=APPLICANT & vTab & "AAA"
                '.TypeText Text:=AAA
                
                .TypeParagraph 'for each location
                .TypeText Text:="blahblah...more text."
                
                .TypeParagraph
                .TypeText Text:="blahblah...more text." & Chr(11) & Chr(11)
                
                .TypeParagraph 'for each location
                .TypeText Text:="blahblah...more text."
                
            End With
        End With
        
                With WordApp.ActiveDocument.Hyperlinks(1).Range.Font '// Change 1 to suit if more than 1 hyperlink
                    .Name = ActiveDocument.Styles("Normal").Font.Name '// Or more simply: .Name = "Arial"
                    .Size = ActiveDocument.Styles("Normal").Font.Size '// .Size = 12
                    .Underline = wdUnderlineNone
                    .Color = wdColorAutomatic
                End With
     
    ' Save the Word file And Close it -- will need to move Word creation/save to within For/i loop
    With WordApp
        .ActiveDocument.SaveAs Filename:=SaveAsName
        .ActiveWindow.Close
        ' Kill the Object
        .Quit
    End With
     
    Set WordApp = Nothing
    Set ExcelApp = Nothing
    
    Next i
    
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    End Sub
    Last edited by jeffreybrown; 12-24-2012 at 11:39 AM.

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