09-16-2021
11:49 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
09-16-2021
11:49 AM
Give this version a try. I got rid of all the 'i' variable stuff, because it wasn't needed.
Private Sub ExcelOut(name As String)
Dim odoc As Document
Set odoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
Set oSheet = odoc.Sheets(1)
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oOptions.Value("IncludeTitle") = True
oOptions.Value("AutoFitColumnWidth") = True
Dim oPartsList As PartsList
Dim lname As String
Dim excelname As DataMedium
Set excelname = ThisApplication.TransientObjects.CreateDataMedium
excelname.FileName = name & ".xlsx"
Dim fName As String
fName = excelname.FileName
If Dir(fName) <> "" Then
MsgBox "Excel sheet alreaedy exists. Excel will not be exported."
Exit Sub
End If
' export Parts Lists to excel
For Each oPartsList In oSheet.PartsLists
lname = oPartsList.Title
oOptions.Value("TableName") = lname
oPartsList.Export fName, kMicrosoftExcel, oOptions
Next
'export Wire Run Lists to excel
lname = ""
Dim oWireRun As CustomTable
Dim j As Integer
j = 1
For Each oWireRun In oSheet.CustomTables
If oWireRun.Title = "WIRE RUN LIST" Then
lname = "WIRE RUN LIST " & j
oOptions.Value("TableName") = lname
oWireRun.Export fName, kMicrosoftExcelFormat, oOptions
j = j + 1
End If
Next
'export Cable Run Lists to excel
lname = ""
Dim oCableRun As CustomTable
j = 1
For Each oCableRun In oSheet.CustomTables
If oCableRun.Title = "CABLE RUN LIST" Then
lname = "CABLE WIRE RUN LIST " & j
oOptions.Value("TableName") = lname
oCableRun.Export fName, kMicrosoftExcelFormat, oOptions
j = j + 1
End If
Next
'export Wire Loom Lists Lists to excel
lname = ""
Dim oLoomRun As CustomTable
For Each oLoomRun In oSheet.CustomTables
If oLoomRun.Title = "LOOM PARTS LIST" Then
lname = "LOOM PARTS LIST"
oOptions.Value("TableName") = lname
oLoomRun.Export fName, kMicrosoftExcelFormat, oOptions
End If
Next
End Sub
Wesley Crihfield
(Not an Autodesk Employee)