| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: GetObject Laufzeitfehler (1365 mal gelesen)
|
otm Mitglied Bauingenieur
Beiträge: 167 Registriert: 26.08.2009 MS Win 10 AutoCAD Civil 3D 2023 VBA Enabler 2023 MS Access Database Enginge X64 MSO 365 (64bit)
|
erstellt am: 28. Jan. 2016 08:41 <-- editieren / zitieren --> Unities abgeben:
Liebe Forumsteilnehmer, ich möchte prüfen, ob eine Instanz von Excel läuft, wenn sie nicht läuft, eine neue Instanz öffnen Excel läuft nun, Dann prüfen, ob in dieser Instanz eine bestimmte Datei offen ist. Wenn nicht, die Datei öffnen. Falls es die Datei nicht gibt, diese anlegen und unter Namen der zuvor gesuchten Datei speichern. Die Datei mit dem richtigen Namen ist nun offen. Dann prüfen, ob ein bestimmtes Tabellenblatt in der Datei vorhanden ist wenn es nicht vorhanden ist, dieses Tabellenblatt hinzufügen Das Tabellenblatt ist nun vorhanden. Das gesuchte Tabellenblatt aktivieren, um Daten eingeben zu können. So weit, so gut. Folgende Code habe ich bereits:
Code:
Public Sub Write2XLSFile(varArray() As Variant, strXLSFile As String, strXLSSheet As String, Optional boContinue As Boolean = False, Optional strXLTFile As String = "") '2-dimensionale Matrix in das Tabellenblatt einer XLS-Datei schreiben. 'Unter Verweise... MS Excel auswählen!!'Eingangswerte: 'varArray = 2-dim Matrix mit den Daten, die in das xls-Tabellenblatt geschrieben werden sollen. 'strXLSFile = Dateiname mit kompletter Pfadangabe z.B.: "C:\temp\ExcelTest.xlsx" 'strXLSSheet = Name des Tabellenblattes 'boContinue = Wenn Datei und Tabellenblatt vorhanden: Sollen die Daten unten angefügt werden? 'strXLTFile = Name der Vorlagendatei mit kompletter Pfadangabe z.B.: "C:\temp\ExcelTestVorlage.xlt" 'Variablendefinition Dim intI As Integer, intJ As Integer, intZ As Integer, intS As Integer 'Laufvariablen Dim XLSOff As Boolean ' Attribut für Freigabe am Ende. Dim WBOpen As Boolean ' Datei bereits offen? Dim WBNew As Boolean ' Datei neu erstellen? Dim AnzWB As Integer ' Anzahl der offnen Workbooks Dim SheetExist As Boolean 'Tabellenblatt bereits vorhanden? Dim SheetNew As Boolean 'Tabellenblatt neu gemacht? Dim strXLSSheetOrg As String 'Originalname zwischenspeichern Dim ZStart As Integer 'erste freie Zeile im XLS-Tabellenblatt Dim XLApp As Excel.Application ' Variable für Verweis auf Microsoft Excel. Dim XLwb As Excel.Workbook Dim XLsheet As Excel.Worksheet ' Überprüfen, ob eine Kopie von Microsoft Excel bereits ausgeführt wird. On Error Resume Next ' Fehlerbehandlung zurückstellen. ' GetObject-Funktionsaufruf ohne erstes Argument gibt einen Verweis auf eine Instanz der Anwendung zurück. ' Wenn die Anwendung nicht ausgeführt wird, tritt ein Fehler auf. Set XLApp = GetObject(, "Excel.Application") If Err.Number <> 0 Then XLSOff = True Set XLApp = CreateObject("Excel.Application") XLApp.Application.Visible = True XLApp.Parent.Windows(1).Visible = True End If Err.Clear ' Err-Objekt im Fehlerfall löschen. ' Prüfen auf Microsoft Excel. Wenn Microsoft Excel ausgeführt wird, wird ' dies in die Tabelle ausgeführter Objekte eingetragen. DetectExcel ' Objektvariable so festlegen, dass sie auf die gewünschte Datei verweist. Set XLApp = GetObject(strXLSFile, "Excel.Application") ' Microsoft Excel mit zugehöriger Application-Eigenschaft einblenden. ' Fenster mit der Datei unter Verwendung der Windows-Auflistung des XLApp-Objektverweises anzeigen. XLApp.Application.Visible = True XLApp.Parent.Windows(1).Visible = True 'Überprüfen, ob irgendein Workbook offen ist. ' Workbooks zählen AnzWB = XLApp.Workbooks.Count If AnzWB <> 0 Then 'Überprüfen, ob die Datei bereits geöffnet ist. For Each XLwb In XLApp.Workbooks If UCase(XLwb.FullName) = UCase(strXLSFile) Then WBOpen = True 'Datei ist offen Exit For End If Next XLwb ' Erstes Workbook sichtbar machen 'XLApp.Parent.Windows(1).Visible = True Else ' kein Workbook offen, nur Excel läuft XLSOff = True 'Excel schließen 'optional ' XLApp.Visible = True End If
'XLS ist jetzt offen, aktiviert If WBOpen = False Then 'Workbook ist noch nicht offen ' Workbook öffnen. ' Datei muss vorhanden sein! Ansonsten Fehlerbehandlung On Error Resume Next XLApp.Workbooks.Open strXLSFile 'Datei öffnen. Debug.Print "WB nicht offen? Err.Number= " & Err.Number If Err.Number <> 0 Then 'Datei ist nicht vorhanden: ' -> neues WB aufmachen und speichern. Dann ist sie vorhanden. WBNew = True Set XLwb = XLApp.Workbooks.Add 'Workbook hinzufügen 'und unter dem gewünschten Namen speichern XLwb.SaveAs strXLSFile WBOpen = True Else Debug.Print " Datei ist schon vorhanden und wird geöffnet." End If Err.Clear ' Err-Objekt im Fehlerfall löschen. Set XLwb = XLApp.ActiveWorkbook Else 'Workbook ist bereits offen(, aber u.U. noch nicht aktiv?) Set XLwb = XLApp.Workbook.stgrXLSFile End If intI = 0 'Zähler für Tabellenblattnamenserweiterung auf 0 setzen strXLSSheetOrg = strXLSSheet 'Originalnamen zwischenspeichern CheckSheet: 'Überprüfen, ob es das Tabellenblatt bereits gibt For Each XLsheet In XLwb.Application.Sheets 'XLwb.Sheets Debug.Print XLsheet.Name If UCase(XLsheet.Name) = UCase(strXLSSheet) Then SheetExist = True 'In der Arbeitsmappe gibt es bereits ein Tabellenblatt mit dem gewünschten Namen Exit For End If Next XLsheet 'Tabellenblatt aktiv setzen, erstellen If SheetExist = False Then 'Es gibt noch kein Tabellenblatt mit dem gewünschten Namen Set XLsheet = XLwb.Worksheets.Add With XLsheet .Name = strXLSSheet 'Name des Tabellenblattes festlegen .Move after:=XLwb.Worksheets(XLwb.Worksheets.Count) 'Tabellenblatt ans Ende schieben .Select 'Tabellenblatt auswählen End With Debug.Print " Neues Tabellenblatt erstellt" boContinue = False 'In neues Tabellenblatt schreiben, bei "A1" beginnen Else If boContinue = True Then 'Neue Werte in erster freier Zeile anfügen Set XLsheet = XLwb.Worksheets(strXLSSheet) Else 'boContinue = False 'Neuen Tabellenblattnamen generieren intI = intI + 1 strXLSSheet = strXLSSheetOrg & intI SheetExist = False GoTo CheckSheet 'Prüfen, ob es den Namen schon gibt End If End If 'Tabellenblatt für Eingabe der Matrix aktiv setzen XLwb.Worksheets(strXLSSheet).Select ..... Set XLsheet = Nothing ' Verweis auf Sheet freigeben. ' Speichern der Datei 'Wenn die Datei noch nicht vorhanden war, wurde sie bereits beim Anlegen unter dem gewünschten Namen gespeichert. 'eine Unterscheidung "SaveAs / Save" ist somit nicht mehr notwendig. 'Vorhandene Datei speichern On Error Resume Next XLwb.Save ' Wenn diese Kopie von Microsoft Excel beim Starten des Beispiels ' nicht ausgeführt wurde, wird Excel mit der Quit-Methode des Application-Objekts beendet. ' Wenn Sie versuchen, Microsoft Excel zu beenden, blinkt die Titelleiste, ' und Sie werden in einer Meldung gefragt, ob Sie geladene Dateien speichern möchten. If XLSOff = True Then XLApp.Application.Quit End If Set XLwb = Nothing ' Verweis auf Anwendung und Tabelle freigeben. Set XLApp = Nothing End Sub
Dabei wird in folgender Zeile der Fehler 432 produziert Code:
Set XLApp = GetObject(strXLSFile, "Excel.Application") ' GetObject("C:\temp\ExcelTest.xlsx")
Excel gibt es definitiv auf dem Rechner. Die angegebene Datei gibt es auch definitiv. Es hat auch bereits funktioniert, bis ich versucht habe das XLwb an ein Sub weiterzugeben. Anfangs hatte ich dann den Fehler 91. Vielleicht hilft das weiter? Kann mir da jemand weiterhelfen?
------------------ Grüße aus München Christian Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 28. Jan. 2016 13:43 <-- editieren / zitieren --> Unities abgeben: Nur für otm
Hallo Christian, Ohne jetzt groß auf Deinen Code gesehen zu haben, hier findest Du einen Codeschnipsel aus dem Du das von Dir gewünschte ableiten kannst. Prinzipieller Ablauf: - Gibt es bereits ein geöffnetes Excel? ja - Flag bereits geöffnet nein - Flag von mir geöffnet - Wenn bereits geöffnet: Durchsuchen der Workbooks und evtl. neues öffnen sonst Workbook öffnen - Durchsuchen der Worksheets, wenn gefunden dann aktivieren sonst anlegen Ansonsten halte ich es für sehr gefährlich prinzipiell ein On Error Resume Next aktiviert zu haben. Dies kann man bewußt kurzzeitig einsetzen wenn ein Fehler evtl. erwartet wird, wie z.B. im verlinkten Code, sollte aber gleich wieder zurückgesetzt werden. Bau Dir lieber einen Error-Handler ein, der Dir den Fehlercode ausgibt, das Programm stoppt und Dich zum Fehler zurückführt. Code:
Sub Programm() On Error GoTo Err_Handler (Code) Exit Sub Err_Handler: MsgBox "Fehler : " & Err.Number & " : " & Err.Description Stop ' Weiter mit Einzelschritten ( F8 ) Resume Next End Sub
Zur Fehlermeldung (die in Deinem Code natürlich nicht in der angegebenen Zeile steht: (ungetestet) Die Variable wird als String übernommen, es könnte sein dass der Fehler dadurch ausgelöst wird weil GetObject() ein oder zwei Variantwerte erwartet. Hoffe das hilft soweit Grüße Klaus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
otm Mitglied Bauingenieur
Beiträge: 167 Registriert: 26.08.2009 MS Win 10 AutoCAD Civil 3D 2023 VBA Enabler 2023 MS Access Database Enginge X64 MSO 365 (64bit)
|
erstellt am: 29. Jan. 2016 07:28 <-- editieren / zitieren --> Unities abgeben:
|
Stelli1 Moderator Verm.-Ing.
Beiträge: 1521 Registriert: 17.08.2005 Map 2000-2014, Rasterdesign, MapGuide, Autodesk Topobase, VS6, VS.net 2013
|
erstellt am: 29. Jan. 2016 10:20 <-- editieren / zitieren --> Unities abgeben: Nur für otm
Hallo Christian, Zitat: Set XLApp = GetObject(strXLSFile, "Excel.Application") ' GetObject("C:\temp\ExcelTest.xlsx")
Das ist auch falsch. Die Path Variable sollte ein möglichen Pfad zur Anwendung und nicht den zu einem Dokument übergeben. Das muss du da rausnehmen. Du hast in deinem Code doch den richtigen Weg schon drin. Also in XLApp.Workbooks schaust du nach ob die Datei schon geöffnet ist und wenn du sie nicht findest öffnest du die Datei. Wilfried Stelberg ------------------ Warum lisp'eln wenn's auch anders geht. www.ib-stelberg.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
otm Mitglied Bauingenieur
Beiträge: 167 Registriert: 26.08.2009 MS Win 10 AutoCAD Civil 3D 2023 VBA Enabler 2023 MS Access Database Enginge X64 MSO 365 (64bit)
|
erstellt am: 29. Jan. 2016 12:34 <-- editieren / zitieren --> Unities abgeben:
Hallo Wilfried, diese Zeile ist aus der Hilfe kopiert.
Code:
' Objektvariable so festlegen, daß sie auf die gewünschte Datei verweist. Set XL1 = Getobject("c:\vb4\TEST1.XLS")
Aber ich werd's mal anders versuchen. Danke. ------------------ Grüße aus München Christian Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 29. Jan. 2016 12:42 <-- editieren / zitieren --> Unities abgeben: Nur für otm
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|