Hi all
I am a new user here but have been using VBA for a while. I am a bit stumped by the 462 error I keep getting. I was wondering if there would be a genius who could see through my code (posted below).
Before I get to the code it is rerunning 10 reports by extracting data from Excel to Word (run via Access Macros). There is a subchecker just checking that there are at least 10 rows of data before a report can run.
The Error as you would know by now is that it runs the first valid report fine and then throws up an error upon trying to reformat a table (see code marked with ****'s. I thought I had specified the necessary applications and documents.
I am stumped. :banghead:
Option Compare Database
Function rrun()
Dim xlExcel ' Excel Application
Dim xlDoc ' Excel Document
Dim ExcelFileLocation ' File location of Excel Chart and data storage for chart
Dim WordReportTemplateLocation ' File location of wrdDoc
Dim WordReportFinalLocation ' File location to save final document (chart inserted and resized)
Dim ExcelDataSheet() ' Sheet name in ExcelChartLocation
Dim ChartName() ' Chart sheet name within ExcelChartLocation
Dim BookmarkName() ' Position in wrdDoc where Chart is to be placed
Dim hpath As String ' pathway variable
Dim record ' Recordset used to populate ExcelDataSheet to be used in chart
Dim tableName() ' Access table name to use when populating ExcelDataSheet
Dim PrinterName ' Name of Adobe printer
Dim FinalChartWidth ' used to fit the imported Chart in the page margins and resize using aspect ratio
Dim FinalChartHeight ' used to fit the imported Chart in the page margins and resize using aspect ratio
Dim Numgroups ' extracted Number of Groups
Dim NumDecgroups ' extracted Number of Groups with 10 or more respondents
Dim OrgName As String ' extracted Org Name
Dim OrgNum As String ' Number of employees invited to survey
Dim SubName As String ' extracted Sub Org Name
Dim j As Integer ' Looping operand
Dim k As Integer ' Looping operand
Dim l As Integer ' Looping operand
Dim m As Integer ' Looping operand
Dim n As Integer ' Looping operand
Dim p As Integer ' Looping operand
Dim q As Integer ' Looping operand
Dim r As Integer ' Looping operand for sub-report loops
Dim repcount As Integer ' Looping operand for sub-report loops
Dim mwe As Integer ' Text row operand
Dim mlw As Integer ' Text row operand
Dim red As Integer ' Text row operand
Dim inc As Integer ' Text row operand
Dim orp As Integer ' Text row operand
Dim orn As Integer ' Text row operand
Dim subck ' This is the subcheck run for sub-reports being more than 10 respondents
'---------------------- Variables --------------------------
ReDim ChartName(1)
ChartName(1) = "G1"
ReDim BookmarkName(1)
BookmarkName(1) = "s1"
'RESET check all of these following tables are now presenting all 80 question data
ReDim tableName(2)
tableName(1) = "NameOrg"
tableName(2) = "NameSubs"
ReDim ExcelDataSheet(16)
ExcelDataSheet(1) = "D1"
ExcelDataSheet(2) = "D2"
ExcelDataSheet(3) = "D3"
ExcelDataSheet(4) = "C1"
ExcelDataSheet(5) = "C2"
ExcelDataSheet(6) = "C3"
ExcelDataSheet(7) = "C4"
ExcelDataSheet(8) = "S1"
ExcelDataSheet(9) = "S2"
ExcelDataSheet(10) = "S3"
ExcelDataSheet(11) = "S4"
ExcelDataSheet(12) = "Refs"
ExcelDataSheet(13) = "TO"
ExcelDataSheet(14) = "TS"
ExcelDataSheet(15) = "Append"
ExcelDataSheet(16) = "Append2"
'--------------------- Allocate a printer --------------------------
PrinterName = "Adobe PDF"
'--------------------- Suck out the pathway --------------------------
hpath = CurrentProject.Path
ExcelFileLocation = hpath & "\All Data Processor.xlsx"
WordReportTemplateLocation = hpath & "\Child Report Template.docx"
WordReportFinalLocation = "Report -- Child -- "
'--------------------- Open Excel --------------------------
Set xlExcel = CreateObject("EXCEL.APPLICATION")
Set xlDoc = xlExcel.workbooks.Open(ExcelFileLocation)
xlExcel.Visible = True
'------------------ Write Names to Excel - Overall --------------------
Set record = CurrentDb().TableDefs(tableName(1)).OpenRecordset
xlDoc.Worksheets(ExcelDataSheet(12)).Activate
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 1).CopyFromRecordset record
record.Close
Set record = CurrentDb().TableDefs(tableName(2)).OpenRecordset
xlDoc.Worksheets(ExcelDataSheet(12)).Activate
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(25, 1).CopyFromRecordset record
record.Close
'-----------------------Suck Number of Sub Orgs ------------------
Numgroups = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(12, 6))
'-----------------------Report Loops Start Here---------------------
r = 0
subck = 0
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 19).Value = 1
For r = 1 To Numgroups
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 19).Value = r
subck = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(2, 20))
If subck = "N" Then
GoTo Zowie:
End If
'-----------------------Suck Number of Sub Orgs --------------------
NumDecgroups = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(13, 6))
'-----------------------Org Name and Sub Names ------------------
OrgName = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 1))
SubName = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(3, 19))
'-----------------------Org Number ------------------
OrgNum = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 2))
'---------------------- New Dims ----------------------
Dim wrdWord As Word.Application ' Word Application
Dim wrdDoc As Word.Document ' Word Document
'---------------------- Open Word and Save ----------------------
On Error Resume Next
Set wrdWord = GetObject(, "Word.Application")
If Err <> 0 Then
Set wrdWord = CreateObject("Word.Application")
End If
On Error GoTo 0
With wrdWord ' start massive With
Set wrdDoc = wrdWord.Documents.Open(WordReportTemplateLocation)
'wrdWord.ActiveDocument.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & ".rtf", FileFormat:=wdFormatRTF
'wrdWord.ActiveDocument.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
'wrdWord.wrdDoc.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
'wrdDoc.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
.ActiveDocument.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
End With
'---------------------- start copying basic data from Excel to Word ----------------------
wrdWord.Application.Visible = True
'---------------------- s1 ----------------------
xlDoc.Worksheets(ExcelDataSheet(12)).Activate
'wrdWord.Selection.Goto What:=wdGoToBookmark, Name:=BookmarkName(1)
'xlDoc.Worksheets(ExcelDataSheet(12)).Cells(2, 19).Copy
'wrdWord.Selection.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine
If wrdWord.ActiveDocument.Bookmarks.Exists(BookmarkName(1)) Then
wrdWord.ActiveDocument.Bookmarks(BookmarkName(1)).Range.select
End If
'If wrdDoc.Bookmarks.Exists(BookmarkName(1)) Then
'wrdDoc.Bookmarks(BookmarkName(1)).Range.select
'End If
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(2, 19).Copy
'wrdWord.Selection.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine
wrdWord.Selection.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine
wrdWord.Selection.TypeBackspace
'---------------------- Resize Charts as required -------------------------
' If wrdWord.ActiveDocument.InlineShapes
.Type = wdDeviceIndependentBitmap Then
' wrdWord.ActiveDocument.InlineShapes
.Width = 210
' wrdWord.ActiveDocument.InlineShapes
.Height = 140
' End If
wrdDoc.InlineShapes(1).Width = 300
wrdDoc.InlineShapes(1).Height = 250
'---------------------- Update Table of contents ----------------------------
wrdWord.ActiveDocument.TablesOfContents(1).UpdatePageNumbers
'wrdDoc.TablesOfContents(1).UpdatePageNumbers
'---------------------- Reformat some text and formatting ---------------------
DoEvents
wrdWord.Selection.MoveDown Unit:=wdLine, Count:=1
wrdWord.Selection.Tables(1).select
With wrdWord.Selection.ParagraphFormat
'******ERROR 462 HERE ON NEXT LINE ****************
.LeftIndent = CentimetersToPoints(0)
'******ERROR 462 HERE ON PREVIOUS LINE ****************
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 3
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
'.MirrorIndents = False
'.TextboxTightWrap = wdTightNone
End With
'End With 'End massive With
'---------------------- Save and Quit Word ---------------------
'wrdWord.ActiveDocument.Save
'wrdWord.ActiveDocument.Close
wrdDoc.Save
wrdWord.Quit
Set wrdWord = Nothing
Set wrdDoc = Nothing
' --------------------- Jump option ---------------------
Zowie:
'---------------------- Continue Loops ------------------
DoEvents
Next r
'---------------------- Quit Excel ---------------------
xlExcel.ActiveWorkbook.Save
xlExcel.ActiveWorkbook.Close
xlExcel.Quit
'-------------------- Free Variables --------------------
Set xlExcel = Nothing
Set wrdWord = Nothing
Set wrdDoc = Nothing
Set xlDoc = Nothing
Set record = Nothing
Set Numgroups = Nothing
Set WordReportTemplateLocation = Nothing
Set WordReportFinalLocation = Nothing
Set PrinterName = Nothing
End Function
I am a new user here but have been using VBA for a while. I am a bit stumped by the 462 error I keep getting. I was wondering if there would be a genius who could see through my code (posted below).
Before I get to the code it is rerunning 10 reports by extracting data from Excel to Word (run via Access Macros). There is a subchecker just checking that there are at least 10 rows of data before a report can run.
The Error as you would know by now is that it runs the first valid report fine and then throws up an error upon trying to reformat a table (see code marked with ****'s. I thought I had specified the necessary applications and documents.
I am stumped. :banghead:
Option Compare Database
Function rrun()
Dim xlExcel ' Excel Application
Dim xlDoc ' Excel Document
Dim ExcelFileLocation ' File location of Excel Chart and data storage for chart
Dim WordReportTemplateLocation ' File location of wrdDoc
Dim WordReportFinalLocation ' File location to save final document (chart inserted and resized)
Dim ExcelDataSheet() ' Sheet name in ExcelChartLocation
Dim ChartName() ' Chart sheet name within ExcelChartLocation
Dim BookmarkName() ' Position in wrdDoc where Chart is to be placed
Dim hpath As String ' pathway variable
Dim record ' Recordset used to populate ExcelDataSheet to be used in chart
Dim tableName() ' Access table name to use when populating ExcelDataSheet
Dim PrinterName ' Name of Adobe printer
Dim FinalChartWidth ' used to fit the imported Chart in the page margins and resize using aspect ratio
Dim FinalChartHeight ' used to fit the imported Chart in the page margins and resize using aspect ratio
Dim Numgroups ' extracted Number of Groups
Dim NumDecgroups ' extracted Number of Groups with 10 or more respondents
Dim OrgName As String ' extracted Org Name
Dim OrgNum As String ' Number of employees invited to survey
Dim SubName As String ' extracted Sub Org Name
Dim j As Integer ' Looping operand
Dim k As Integer ' Looping operand
Dim l As Integer ' Looping operand
Dim m As Integer ' Looping operand
Dim n As Integer ' Looping operand
Dim p As Integer ' Looping operand
Dim q As Integer ' Looping operand
Dim r As Integer ' Looping operand for sub-report loops
Dim repcount As Integer ' Looping operand for sub-report loops
Dim mwe As Integer ' Text row operand
Dim mlw As Integer ' Text row operand
Dim red As Integer ' Text row operand
Dim inc As Integer ' Text row operand
Dim orp As Integer ' Text row operand
Dim orn As Integer ' Text row operand
Dim subck ' This is the subcheck run for sub-reports being more than 10 respondents
'---------------------- Variables --------------------------
ReDim ChartName(1)
ChartName(1) = "G1"
ReDim BookmarkName(1)
BookmarkName(1) = "s1"
'RESET check all of these following tables are now presenting all 80 question data
ReDim tableName(2)
tableName(1) = "NameOrg"
tableName(2) = "NameSubs"
ReDim ExcelDataSheet(16)
ExcelDataSheet(1) = "D1"
ExcelDataSheet(2) = "D2"
ExcelDataSheet(3) = "D3"
ExcelDataSheet(4) = "C1"
ExcelDataSheet(5) = "C2"
ExcelDataSheet(6) = "C3"
ExcelDataSheet(7) = "C4"
ExcelDataSheet(8) = "S1"
ExcelDataSheet(9) = "S2"
ExcelDataSheet(10) = "S3"
ExcelDataSheet(11) = "S4"
ExcelDataSheet(12) = "Refs"
ExcelDataSheet(13) = "TO"
ExcelDataSheet(14) = "TS"
ExcelDataSheet(15) = "Append"
ExcelDataSheet(16) = "Append2"
'--------------------- Allocate a printer --------------------------
PrinterName = "Adobe PDF"
'--------------------- Suck out the pathway --------------------------
hpath = CurrentProject.Path
ExcelFileLocation = hpath & "\All Data Processor.xlsx"
WordReportTemplateLocation = hpath & "\Child Report Template.docx"
WordReportFinalLocation = "Report -- Child -- "
'--------------------- Open Excel --------------------------
Set xlExcel = CreateObject("EXCEL.APPLICATION")
Set xlDoc = xlExcel.workbooks.Open(ExcelFileLocation)
xlExcel.Visible = True
'------------------ Write Names to Excel - Overall --------------------
Set record = CurrentDb().TableDefs(tableName(1)).OpenRecordset
xlDoc.Worksheets(ExcelDataSheet(12)).Activate
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 1).CopyFromRecordset record
record.Close
Set record = CurrentDb().TableDefs(tableName(2)).OpenRecordset
xlDoc.Worksheets(ExcelDataSheet(12)).Activate
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(25, 1).CopyFromRecordset record
record.Close
'-----------------------Suck Number of Sub Orgs ------------------
Numgroups = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(12, 6))
'-----------------------Report Loops Start Here---------------------
r = 0
subck = 0
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 19).Value = 1
For r = 1 To Numgroups
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 19).Value = r
subck = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(2, 20))
If subck = "N" Then
GoTo Zowie:
End If
'-----------------------Suck Number of Sub Orgs --------------------
NumDecgroups = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(13, 6))
'-----------------------Org Name and Sub Names ------------------
OrgName = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 1))
SubName = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(3, 19))
'-----------------------Org Number ------------------
OrgNum = CStr(xlDoc.Worksheets(ExcelDataSheet(12)).Cells(1, 2))
'---------------------- New Dims ----------------------
Dim wrdWord As Word.Application ' Word Application
Dim wrdDoc As Word.Document ' Word Document
'---------------------- Open Word and Save ----------------------
On Error Resume Next
Set wrdWord = GetObject(, "Word.Application")
If Err <> 0 Then
Set wrdWord = CreateObject("Word.Application")
End If
On Error GoTo 0
With wrdWord ' start massive With
Set wrdDoc = wrdWord.Documents.Open(WordReportTemplateLocation)
'wrdWord.ActiveDocument.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & ".rtf", FileFormat:=wdFormatRTF
'wrdWord.ActiveDocument.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
'wrdWord.wrdDoc.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
'wrdDoc.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
.ActiveDocument.SaveAs FileName:=hpath & "\" & WordReportFinalLocation & OrgName & " - " & SubName & ".docx", FileFormat:=wdFormatXMLDocument
End With
'---------------------- start copying basic data from Excel to Word ----------------------
wrdWord.Application.Visible = True
'---------------------- s1 ----------------------
xlDoc.Worksheets(ExcelDataSheet(12)).Activate
'wrdWord.Selection.Goto What:=wdGoToBookmark, Name:=BookmarkName(1)
'xlDoc.Worksheets(ExcelDataSheet(12)).Cells(2, 19).Copy
'wrdWord.Selection.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine
If wrdWord.ActiveDocument.Bookmarks.Exists(BookmarkName(1)) Then
wrdWord.ActiveDocument.Bookmarks(BookmarkName(1)).Range.select
End If
'If wrdDoc.Bookmarks.Exists(BookmarkName(1)) Then
'wrdDoc.Bookmarks(BookmarkName(1)).Range.select
'End If
xlDoc.Worksheets(ExcelDataSheet(12)).Cells(2, 19).Copy
'wrdWord.Selection.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine
wrdWord.Selection.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine
wrdWord.Selection.TypeBackspace
'---------------------- Resize Charts as required -------------------------
' If wrdWord.ActiveDocument.InlineShapes

' wrdWord.ActiveDocument.InlineShapes

' wrdWord.ActiveDocument.InlineShapes

' End If
wrdDoc.InlineShapes(1).Width = 300
wrdDoc.InlineShapes(1).Height = 250
'---------------------- Update Table of contents ----------------------------
wrdWord.ActiveDocument.TablesOfContents(1).UpdatePageNumbers
'wrdDoc.TablesOfContents(1).UpdatePageNumbers
'---------------------- Reformat some text and formatting ---------------------
DoEvents
wrdWord.Selection.MoveDown Unit:=wdLine, Count:=1
wrdWord.Selection.Tables(1).select
With wrdWord.Selection.ParagraphFormat
'******ERROR 462 HERE ON NEXT LINE ****************
.LeftIndent = CentimetersToPoints(0)
'******ERROR 462 HERE ON PREVIOUS LINE ****************
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 3
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
'.MirrorIndents = False
'.TextboxTightWrap = wdTightNone
End With
'End With 'End massive With
'---------------------- Save and Quit Word ---------------------
'wrdWord.ActiveDocument.Save
'wrdWord.ActiveDocument.Close
wrdDoc.Save
wrdWord.Quit
Set wrdWord = Nothing
Set wrdDoc = Nothing
' --------------------- Jump option ---------------------
Zowie:
'---------------------- Continue Loops ------------------
DoEvents
Next r
'---------------------- Quit Excel ---------------------
xlExcel.ActiveWorkbook.Save
xlExcel.ActiveWorkbook.Close
xlExcel.Quit
'-------------------- Free Variables --------------------
Set xlExcel = Nothing
Set wrdWord = Nothing
Set wrdDoc = Nothing
Set xlDoc = Nothing
Set record = Nothing
Set Numgroups = Nothing
Set WordReportTemplateLocation = Nothing
Set WordReportFinalLocation = Nothing
Set PrinterName = Nothing
End Function