PDA

View Full Version : automation error



clif
03-18-2014, 12:40 AM
There is automation error in the following code.
How to solve it



Sub Transfer()

Dim wb As Workbook
Dim ws As Worksheet
Dim wrdApp As Word.Application
Dim wrdDoc As Document
'assign object values
Set wb = ThisWorkbook
Set ws = wb.Sheets("Transfer")
Set wrdApp = CreateObject("Word.Application")

Dim a As Integer
For a = 2 To 4
ws.Activate
Set wrdDoc = wrdApp.Documents.Open(ws.Cells(a, 2).Value)
wrdApp.Visible = False
wrdDoc.Activate
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
ws.Cells(a, 4).Value, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
wrdDoc.Close
wrdApp.Quit


Next a


Set wrdDoc = Nothing
Set wrdApp = Nothing
Set ws = Nothing
Set wb = Nothing

End Sub

ashleyuk1984
03-18-2014, 01:02 AM
What line is causing the error? What are you trying to achieve? Any sample files?

Bob Phillips
03-18-2014, 01:34 AM
Is it the ACtiveDocument line? I would have thought that is a Word VBA object, not Excel VBA, so maybe


Sub Transfer()

Dim wb As Workbook
Dim ws As Worksheet
Dim wrdApp As Word.Application
Dim wrdDoc As Document
'assign object values
Set wb = ThisWorkbook
Set ws = wb.Sheets("Transfer")
Set wrdApp = CreateObject("Word.Application")

Dim a As Integer
For a = 2 To 4
ws.Activate
Set wrdDoc = wrdApp.Documents.Open(ws.Cells(a, 2).Value)
wrdApp.Visible = False
'wrdDoc.Activate '<<<<<<< this row deleted, next row amended
wrdDoc.ExportAsFixedFormat OutputFileName:= _
ws.Cells(a, 4).Value, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
wrdDoc.Close
wrdApp.Quit

Next a

Set wrdDoc = Nothing
Set wrdApp = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub

SamT
03-18-2014, 10:28 AM
Do ws.Ranges ("B2:B4") and ("D2:D4") contain the full path and names of the files?