Set objWorkbook = Application.Workbooks.Open(Activ
Hugo
Nachfolgender Code läuft auf Excel 2000 und 2007
Im 2000 egal ob ich die Datei lokal oder über ein Netzlaufwerk gestartet wird.
Im 2007 nur wenn ich die Datei lokal starte.
Wenn ich im 20007 die Datei über ein Netz-LW starte entsteht ein Error bei
Set objWorkbook = Application.Workbooks.Open(ActiveWorkbook.Path & "\" & DB_Dateiname)
Set objSheet = objWorkbook.Sheets(DB_Register)
Was ist falsch?
Besten Dank für eure Hilfe und Gruss Hugo
Hier der gamze Code:
Sub DBDatenKopieren()
Dim objWorkbook As Workbook
Dim objSheet As Worksheet, objZiel As Worksheet
Dim DB_Register As String
Dim DB_Dateiname As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DB_Dateiname = ThisWorkbook.Sheets("StartRegister").Range("C32")
DB_Register = ThisWorkbook.Sheets("StartRegister").Range("C33")
Sheets("Umwandlungstabelle").Visible = True
'Imhalt der Umwandlungstabelle löschen
Sheets("Umwandlungstabelle").Cells.Delete Shift:=xlUp
On Error GoTo Errorhandler 'Wenn falscher Drucker
Application.ActivePrinter = ThisWorkbook.Sheets("StartRegister").Range("D13") 'Der PDF- _
Drucker wird angesteuert
On Error GoTo Fehler 'Wenn Datei nicht vorhanden oder Registername falsch
Set objZiel = ThisWorkbook.Sheets("Umwandlungstabelle")
Set objWorkbook = Application.Workbooks.Open(ActiveWorkbook.Path & "\" & DB_Dateiname)
Set objSheet = objWorkbook.Sheets(DB_Register)
With objSheet
.Range(.Cells(1, 1), .Cells.SpecialCells(xlCellTypeLastCell)).EntireColumn.Copy _
Destination:=objZiel.Range("A1")
End With
Application.CutCopyMode = False
objWorkbook.Close SaveChanges:=False
With objZiel
.Activate
.Range("A1").Select
End With
GoTo ende
Fehler:
If Err.Number 0 Then
If objWorkbook Is Nothing Then
MsgBox "Datei """ & ActiveWorkbook.Path & "\" & DB_Dateiname & """ nicht gefunden!"
ElseIf objSheet Is Nothing Then
objWorkbook.Close SaveChanges:=False
MsgBox "Blatt """ & DB_Register & """ in Datei """ _
& ActiveWorkbook.Path & "\" & DB_Dateiname & """ nicht vorhanden!"
End If
End If
Set objWorkbook = Nothing
Set objSheet = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
ende:
Set objWorkbook = Nothing
Set objSheet = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Call StartCode
Exit Sub
Errorhandler:
MsgBox "Drucker " & ThisWorkbook.Sheets("StartRegister").Range("C13") & " nicht gefunden" _
& Chr(13) & "Zuerst muss der PDF-Drucker im StartRegsiter angepasst werden." _
& Chr(13) & "Danach Umwandlung neu starten"
Sheets("Umwandlungstabelle").Visible = xlVeryHidden
End Sub