VBA Modul wirft in Asien Error ? hier nicht
30.07.2019 10:10:33
Nati93
ich habe ein VBA Modul, welches mir eine von dem User ausgewählte Datei öffnet.
Gleichzeitig wird eine neue Excel geöffnet mit dem Namen "Bufferfile".
Leider bricht der Code bei Auswahl einer Datei des Users ab und zwar bisher nur in China ?... Bei uns funktioniert der Code.
Error 76 #Path not found...
Der Code bricht wahrscheinlich bei
varDatei = Application.GetOpenFilename()
ab:Weiß jemand Rat ? Danke für jede Mühe.
Sub copySWATextractToBuffer()
'-- Variablen
Dim varDatei As String
Dim vArray As Variant
Dim i As Integer
Dim fileName As Variant
Dim QWB As Workbook, ZWB As Workbook
Dim Answer
Dim antwort As String
Dim QWS As Worksheet, ZWS As Worksheet, ZWSBackUp As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
'Fehlerhandling
On Error GoTo Errorhandler
'Bereits Buffer-Datei erstellt?
If Worksheets("SWAT Data Extract").Range("Q6").Value = "X" And IsWorkbookOpen("BTW BufferFile. _
_
xlsx") Then
antwort = MsgBox("You already selected a SWAT data extract, do you want to select a new one? _
_
", _
vbYesNo + vbInformation, "Information")
'User Rückmeldung
Select Case antwort
Case vbNo
Exit Sub
Case vbYes
'Geoeffnetes Bufferfile wird geloescht
Call xLoeschen
Call deleteBufferFile
Call ordnerloeschen
Exit Sub
End Select
End If
'User wählt SWAT Extract Datei aus
Answer = MsgBox("Please select the Excel file of the SWAT Data Extract", vbOKCancel + _
vbInformation, _
"File selection.")
'User Rückmeldung
Select Case Answer
Case vbOK '=1 'Gesichert Format(Date(),"DD.MM.YYYY")
Case vbCancel '=2 'Abgebrochen oder rotes X
Exit Sub
End Select
varDatei = Application.GetOpenFilename()
'Fehlerbehandlung wenn Nutzer auf Abbrechen klickt (bei DATEIAUSWAHL) - rotes X oder abbrechen
If varDatei = "Falsch" Or varDatei = "False" Then Exit Sub
vArray = Split(varDatei, "\")
For i = 0 To UBound(vArray)
fileName = vArray(i)
Next i
'Swat Datei oeffnen
Workbooks.Open varDatei
Set QWB = ActiveWorkbook
ThisWorkbook.Activate
'Wenn Datei ausgewählt dann Ordner erstellen + BufferFile erstellen
Call createFolder
'Buffer Excel-Sheet
Set ZWB = Workbooks("BTW BufferFile.xlsx")
'Sheets zuweisen zu...
'...SWAT Datei
Set QWS = QWB.Worksheets("Sheet1")
'... Buffer Excel-Sheet
Set ZWS = ZWB.Worksheets("Tabelle1")
'Benutzte Zellen der SWAT Datei kopieren in Buffer Excel-Sheet,
'Ziel: In Zeile 8 Spalte 1
QWS.UsedRange.Copy ZWS.Cells(8, 1)
Workbooks(fileName).Close SaveChanges:=True
Application.EnableEvents = True
'STEP 2 als erledigt markieren
Worksheets("SWAT Data Extract").Shapes.Range(Array("haken2")).Visible = True
MsgBox ("Successful! - Please go to STEP 3.")
Exit Sub
'--- Bei Fehler:
Errorhandler:
If Err.Number = 9 Then
'Falls Bufferfile noch offen ist...
If IsWorkbookOpen("BTW BufferFile.xlsx") Then
MsgBox "There is a failure in the SWAT Data Export Workbook." & _
" Please rename the corresponding Worksheet to Sheet1.", vbCritical, "An error has _
occured!"
SwatExtractToBTW.Show
'Bufferfile schließen + loeschen
Call deleteBufferFile
' Call ordnerloeschen
Call xLoeschen
Else
'Bufferfile wurde schon geschlossen
MsgBox "No SWAT-Data found!." & Chr(13) & "Please select the SWAT-Data-File again.", _
vbCritical, "An error has occured!"
' Call deleteBufferFile
' Call ordnerloeschen
Call xLoeschen
Worksheets("SWAT Data Extract").Shapes.Range(Array("haken2")).Visible = False
End If
Else:
MsgBox Err.Description & Chr(13) & Err.Number & Chr(13) & Err.Source, _
vbCritical, "An error has occured!"
Worksheets("SWAT Data Extract").Range("Q6").ClearContents
End If
Exit Sub
End Sub