D
David Turner
I tried to adapt some code posted in earlier threads to export a set of
embedded Excel worksheets and save them as separate Excel files. It runs fine
when I step through by pressing F8 or even when I set an F9 breakpoint on the
"SaveAs" line, but throws a run error 1004 (the SaveAs method of the
'_Workbook' object failed) on the first For loop (at the SaveAs line) when i
try to run it normally using F5.
Can anyone see what's going wrong?
Thanks
Sub ExportEmbeddedSheetsAsExcel()
Dim iCtr As Integer
Dim xlWB As Excel.Workbook
Dim oDoc As Document
Dim oDcOle As Word.OLEFormat
Dim strDocName As String
strDocName = ActiveDocument.FullName
Set oDoc = ActiveDocument
For iCtr = 1 To oDoc.InlineShapes.Count
If oDoc.InlineShapes(iCtr).Type = wdInlineShapeEmbeddedOLEObject Then
If oDoc.InlineShapes(iCtr).OLEFormat.ClassType = "Excel.Sheet.8"
Then
Set oDcOle = oDoc.InlineShapes(iCtr).OLEFormat
oDcOle.DoVerb wdOLEVerbPrimary
Set xlWB = oDcOle.Object
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 2)
strDocName = strDocName & iCtr & ".xls"
xlWB.SaveAs FileName:=strDocName
xlWB.Close
End If
End If
Next iCtr
Set xlWB = Nothing
Set oDoc = Nothing
Set oDcOle = Nothing
End Sub
embedded Excel worksheets and save them as separate Excel files. It runs fine
when I step through by pressing F8 or even when I set an F9 breakpoint on the
"SaveAs" line, but throws a run error 1004 (the SaveAs method of the
'_Workbook' object failed) on the first For loop (at the SaveAs line) when i
try to run it normally using F5.
Can anyone see what's going wrong?
Thanks
Sub ExportEmbeddedSheetsAsExcel()
Dim iCtr As Integer
Dim xlWB As Excel.Workbook
Dim oDoc As Document
Dim oDcOle As Word.OLEFormat
Dim strDocName As String
strDocName = ActiveDocument.FullName
Set oDoc = ActiveDocument
For iCtr = 1 To oDoc.InlineShapes.Count
If oDoc.InlineShapes(iCtr).Type = wdInlineShapeEmbeddedOLEObject Then
If oDoc.InlineShapes(iCtr).OLEFormat.ClassType = "Excel.Sheet.8"
Then
Set oDcOle = oDoc.InlineShapes(iCtr).OLEFormat
oDcOle.DoVerb wdOLEVerbPrimary
Set xlWB = oDcOle.Object
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 2)
strDocName = strDocName & iCtr & ".xls"
xlWB.SaveAs FileName:=strDocName
xlWB.Close
End If
End If
Next iCtr
Set xlWB = Nothing
Set oDoc = Nothing
Set oDcOle = Nothing
End Sub