I have Visio Vba macro that is supposed to take in a file path to an excel sheet from a global var. Then it opens that file, generates a new excel sheet, and takes the sheets from the old path and copies them to the generated file. My problem is copying the sheets over. The first file I give it sometimes works, but when I run another or the same file again, when it runs this specific line:
PriceWs.Copy After:=excelWorkbook.Sheets("Sheet1")
I get the run time 1004 error: No such interface supported, and I can't figure out why it keeps doing that.
If it helps, I receive the file path through a global string that just holds the Filepath. Example value: C:\Users\things\Documents\TESTING.xlsx
I run this code through a command button on a user form that just runs this macro and nothing else.
Also while debugging, the PriceWs type is worksheet/worksheet if that matters, but again the code sometimes runs while it was this type.
Sub CombineExcel()
Dim PriceWb As Workbook
Dim PriceWs As Worksheet
Dim PriceString As String
'Error checking for a good file
'Global is a global string that holds the path to an excel file
PriceString = GlobalPriceList
Debug.Print "Price String: " & PriceString
On Error Resume Next
Set PriceWb = Workbooks.Open(PriceString)
On Error GoTo 0
If PriceWb Is Nothing Then
MsgBox "Error: The file is not a valid Excel file or it could not be opened.", vbCritical
Exit Sub
End If
' Initialize Excel
Set excelApp = CreateObject("Excel.Application")
Dim excelWorkbook As Object
Dim excelWorksheet As Object
Set excelApp = New Excel.Application
excelApp.Visible = True ' Optional, set to True if you want Excel to be visible
Set excelWorkbook = excelApp.Workbooks.Add
Set excelWorksheet = excelWorkbook.Sheets(1)
' Loop through each sheet in the source workbook
For Each PriceWs In PriceWb.Sheets
On Error Resume Next
PriceWs.Copy After:=excelWorkbook.Sheets(excelWorkbook.Sheets.count)
If Err.Number <> 0 Then
Debug.Print "Type Name is: " & TypeName(PriceWs)
MsgBox "Error copying sheet '" & PriceWs.Name & "': " & Err.Description, vbCritical
End If
On Error GoTo 0
Next PriceWs
Debug.Print GlobalPriceList
' Delete the Sheet1 without prompting for confirmation
'Application.DisplayAlerts = False ' Suppress the alert asking for confirmation
'excelWorkbook.Sheets("Sheet1").Delete
'Application.DisplayAlerts = True ' Restore the display alerts setting
' Release object references
Set excelWorksheet = Nothing
Set excelWorkbook = Nothing
Set excelApp = Nothing
Set PriceWs = Nothing
End Sub
PS: if this helps, this is the code I use to get the file path from the end user since I can't use GetOpenFilename in visio's vba:
Dim wShell As Object, sPath As String, oExec As Variant
' Create an instance of the WScript.Shell object
Set wShell = CreateObject("WScript.Shell")
' Execute a command line using mshta.exe with an HTML script as an argument
' The HTML script dynamically generates an HTML page with a file input element and JavaScript code to interact with it
Set oExec = wShell.Exec("mshta.exe ""about:<input type=file id=FILE accept=.xls,.xlsx><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
' Read the file path from the standard output of the executed command
sPath = oExec.StdOut.ReadLine
Please check description of method Worksheet.Copy
Copies the sheet to another location in the current workbook or a new workbook.
About Error 1004
Source and Destination must be in the same Excel.Application instance, otherwise it will raise a runtime error '1004': No such interface supported, if something like
Sheet1.Copy objWb.Sheets(1)was used, or a runtime error '1004': Copy method of Worksheet class failed, if something likeThisWorkbook.Worksheets("Sheet1").Copy objWb.Sheets(1)was used.
I find that Worksheet.Move method (Excel) can move Worksheets between different Workbooks! I modify your code and run into Excel!
Note: Do not create a new Excel application session to avoid the error!
Sub CombineExcel()
Dim PriceWb As Workbook
Dim PriceWs As Worksheet
Dim PriceString As String
'Error checking for a good file
'Global is a global string that holds the path to an excel file
PriceString = "C:\адЪ\ЛВС.xls" ' my local workbook for tests path
Debug.Print "Price String: " & PriceString
On Error Resume Next
Set PriceWb = Workbooks.Open(PriceString)
On Error GoTo 0
If PriceWb Is Nothing Then
MsgBox "Error: The file is not a valid Excel file or it could not be opened.", vbCritical
Exit Sub
End If
' Initialize Excel
Dim excelApp As Object
Dim excelWorkbook As Object
Dim excelWorksheet As Object
' Set excelApp = New Excel.Application
Set excelApp = Application ' !!! DONT CREATE NEW EXCEL's session !!!
excelApp.Visible = True ' Optional, set to True if you want Excel to be visible
Set excelWorkbook = excelApp.Workbooks.Add
Set excelWorksheet = excelWorkbook.Sheets(1)
' Loop through each sheet in the source workbook
For Each PriceWs In PriceWb.Sheets
On Error Resume Next
PriceWs.Copy After:=excelWorkbook.Sheets(excelWorkbook.Sheets.Count)
If Err.Number <> 0 Then
Debug.Print "Type Name is: " & TypeName(PriceWs)
MsgBox "Error copying sheet '" & PriceWs.Name & "': " & Err.Description, vbCritical
End If
On Error GoTo 0
Next PriceWs
Debug.Print GlobalPriceList
' Delete the Sheet1 without prompting for confirmation
'Application.DisplayAlerts = False ' Suppress the alert asking for confirmation
'excelWorkbook.Sheets("Sheet1").Delete
'Application.DisplayAlerts = True ' Restore the display alerts setting
' Release object references
Set excelWorksheet = Nothing
Set excelWorkbook = Nothing
Set excelApp = Nothing
Set PriceWs = Nothing
End Sub
PS What about MS Visio?
PPS I ported code to Visio document, there you can find rows for late or early bindings
Visio haven't build-in file dialogs which can select for open documents.
Please read more in these threads:
Open a fileDialog in visio vba
Add Open File Dialog to VBA