Automation Error

kreitzig

New Member
Joined
Dec 19, 2012
Messages
5
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.
The line of code that it is giving the error on is:
Code:
With WordApp
    .ActiveDocument.SaveAs Filename:=SaveAsName
    .ActiveWindow.Close
    ' Kill the Object
    .Quit
End With
(on .Quit)

Here is the code for the sheet:
Code:
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:="[url=http://cnn.com]CNN.com - Breaking News, U.S., World, Weather, Entertainment & Video News[/url]", _
            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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Forum statistics

Threads
1,215,944
Messages
6,127,835
Members
449,411
Latest member
adunn_23

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top