nur keine Panik.
Die Meldung "Geschlossen" entstammt der Fehlerroutine im Makro.
Wenn die CSV-Datei bereits geöffnet wird, darf die CSV-Datei
nicht noch einmal per Makro geöffnet werden.
Deshalb wird die CSV-Datei vom Makro aus geschlossen, aber nicht gespeichert!
Jetzt ist das Programm bereit für einen Neuanfang.
Der Reihe nach:
- Kommt es zu der Meldung (Im neuen Makro)
"Die CSV-Datei 'Hans_Meerkatz*.CSV' ist bereits geöffnet und wird nun geschlossen!"
, dann wird die CSV-Datei ungespeichert geschlossen. - Du siehst in Calc nun eine unbearbeitet oder teilbearbeitete
Datei (Unbenannt xxx) dies kannst Du schließen ohne zu speichern - Fange nochmal von vorn an:
Menü Datei → Dokumentvorlagen → Dokumentvorlage verwalten... - Jetzt läuft das Makro wieder ohne Aufruf der Fehlerroutine.
Wenn Du die CSV-Datei zur Bearbeitung geöffnet hast, dann
musst Du die CSV-Datei erst schließen, um das Makro zu starten.
Ich hätte die Fehlermeldung etwas ausführlicher gestalten sollen.
Deshalb hier eine geänderte Makro-Version:
Code: Alles auswählen
REM ***** BASIC *****
Option Explicit
Dim oDocCSV as Object
REM modCSVImport
Sub [CSV_DATEN importieren]
Dim oDocAusVorlage as Object
Dim oAllComponents as Object
Dim oElements as Object
Dim oElement as Object
Dim oSheetAusVorlage as Object
Dim oRange1AusVorlage as Object
Dim oRange2AusVorlage as Object
Dim oRange3AusVorlage as Object
Dim oSheet as Object
Dim oRange1 as Object
Dim oRange2 as Object
Dim oRange3 as Object
Dim oRange4 as Object
Dim oCellCursor as Object
Dim fSekunde as Double
Dim fTime as Double
Dim nEndRow1 as Long
Dim nEndRow2 as Long
Dim nCnt1 as Long
Dim nCnt2 as Long
Dim nCnt3 as Long
Dim mData1() as Variant ' Array für die Daten
Dim mData2() as Variant ' Array für die Daten
Dim mData3() as Variant ' Array für die Daten
Dim sFileCSV as String
Dim sPath as String
Dim sFile as String
Dim sUrl as String
Dim bFound as Boolean
oDocAusVorlage=ThisComponent
oSheetAusVorlage=oDocAusVorlage.CurrentController.ActiveSheet
oRange1AusVorlage=oSheetAusVorlage.getCellRangeByName("A2:C2")
oRange2AusVorlage=oSheetAusVorlage.getCellRangeByName("A4:C86410")
REM ---------------------------------------------------------------------------
REM Zellinhalte löschen
REM
REM VALUE Nummerische Werte
REM DATETIME Datum/Zeit-Werte
REM STRING Text
REM ANNOTATION Die Notiz
REM FORMULA Formeln
REM HARDATTR Die harten Formatierungen
REM STYLES Styles
REM OBJECTS Grafik
REM EDITATTR Textformartierungen ?
oRange1AusVorlage.ClearContents(com.sun.star.sheet.CellFlags.VALUE _
+ com.sun.star.sheet.CellFlags.STRING _
+ com.sun.star.sheet.CellFlags.DATETIME)
oRange2AusVorlage.ClearContents(com.sun.star.sheet.CellFlags.VALUE _
+ com.sun.star.sheet.CellFlags.STRING _
+ com.sun.star.sheet.CellFlags.DATETIME)
REM ══════════════════════════════════════════════════════════════════════════════════════════════════════
REM Hier die Pfadangabe, bzw. die URL ändern
' Unter Linux auch als URL angeben
sUrl="file:///home/servus/Schreibtisch/Ha/"
sFile=dir(sUrl & "Hans*.csv")
sPath = convertFromUrl(sUrl) & sFile
REM ══════════════════════════════════════════════════════════════════════════════════════════════════════
REM ...................................
REM Prüfen ob die CSV-Datei bereits geöffnet ist
sURL = ConverttoURL(sPath)
bFound=False
oAllComponents = StarDesktop.getComponents
oElements = oAllComponents.CreateEnumeration
Do While oElements.HasMoreElements
oElement = oElements.NextElement
If oElement.hasLocation Then
If oElement.URL = sUrl Then
bFound = True
Goto ErrorHandler
Exit Do
End If
End If
Loop
REM -----------------------------------------------------------------------------------------------------
REM Prüfung ob die Datei existiert.
REM Dazu wird die "FileExists(sUrl)" aufgerufen;
REM "FileExists(sUrl)" = TRUE ' Datei existiert
REM "FileExists(sUrl)" = FALSE ' Datei existiert nicht oder der Dateiname ist falsch, bzw.
REM der Dateiname entspricht nicht den Vorgaben, welche von diesem Makro gefordert werden
If FileExists(sUrl) Then
' "FileExists(sUrl)" = TRUE
' msgBox surl
Else
' "FileExists(sUrl)" = FALSE
msgBox "Die angegebene Datei:" & chr(10) & _
sFileCSV & chr(10) & _
"exisitiert nicht!" & chr(10) & _
"--------------------------------" & chr(10) & _
"Das Programm wird beendet" ,16, "Datei nicht vorhanden"
Exit Sub
End If
REM ...................................
REM CSV-Datei öffnen
sFileCSV = convertToUrl(sPath)
if len(sFileCSV)>0 then
dim mFileProps(2) as new com.sun.star.beans.PropertyValue
mFileProps(0).Name = "FilterName" : mFileProps(0).Value = "Text - txt - csv (StarCalc)"
' der erste Token (59) der Filteroptionen gibt den Datenfeld-Separator an:
' Kommata = 44
' Semikola = 59
mFileProps(1).Name = "FilterOptions" : mFileProps(1).Value = "44,34,76,1,,0,false,true,true,false"
' Datei im Hintergrund öffnen
mFileProps(2).Name = "Hidden" : mFileProps(2).Value = True
oDocCSV = StarDesktop.loadComponentFromURL(sFileCSV, "_blank", 0, mFileProps())
end if
REM ...................................
REM Daten aus dem CSV-File kopieren
oSheet=oDocCSV.CurrentController.ActiveSheet
REM ----------------------------------------------------------------------------------------------------------------------------------------------
' CSV-Datei: letzte befüllte Zelle
oCellCursor = oSheet.createCursor()
oCellCursor.GotoEndOfUsedArea(True)
nEndRow1 = oCellCursor.getRangeAddress.EndRow+1
' CSV-Datei: Zellbereich "C2:E2"
oRange1=oSheet.getCellRangeByName("C2:E2") ' CSV-Daten kopieren
' CSV-Datei: Zellbereich "B4:C (letzte Zeile)"
REM getCellRangeByPosition ( nLeft as long, nTop as long, nRight as long, nBottom as long )
oRange2=oSheet.getCellRangeByPosition(1,3,2,nEndRow1)
' Leeres Array dimensionieren aus Spalte "AX" und "AZ"
oRange3=oSheet.getCellRangeByPosition(49,3,50,nEndRow1)
REM ----------------------------------------------------------------------------------------------------------------------------------------------
mData1()=oRange1.getDataArray() ' CSV-Datei: Daten aus Zellebereich "C2:E2"
mData2()=oRange2.getDataArray() ' CSV-Datei: Daten aus Spalte "B" und "C"
mData3()=oRange3.getDataArray() ' CSV-Datei: Daten aus Spalte "AX" und "AZ" (Daten = "")
REM ----------------------------------------------------------------------------------------------------------------------------------------------
REM CSV-Daten aus Array in neues Dokument schreiben
oSheetAusVorlage.getCellRangeByName("A2:C2").setDataArray(mData1())
oSheetAusVorlage.getCellRangeByPosition(2,3,3,nEndRow1).setDataArray(mData2())
REM neues Dokument: Inhalt "B2" kopieren und in Zelle "B4" schreiben
oSheetAusVorlage.getCellRangeByName("B4").Value= oSheetAusVorlage.getCellRangeByName("B2").Value
REM ----------------------------------------------------------------------------------------------------------------------------------------------
REM Zähler für Spalte A
' neues Dokument: letzte befüllte Zelle
oCellCursor = oSheetAusVorlage.createCursor()
oCellCursor.GotoEndOfUsedArea(True)
nEndRow2 = oCellCursor.getRangeAddress.EndRow+1
fSekunde=oSheetAusVorlage.getCellRangeByName("B4").Value
fTime=oSheetAusVorlage.getCellRangeByName("B4").Value
nCnt2=1 ' Initialisierung: Zähler für Spalte "A"
nCnt3=0
Dim nUB as Long
nUB=uBound(mData3())
mData3(0)(1)=oSheetAusVorlage.getCellRangeByName("$B$2").Value
For nCnt1=1 To nEndRow1
If nCnt3 >nUB Then Exit For
If mData2(nCnt3)(0) = "" OR mData2(nCnt3)(1) = "" Then
' DANN Arrayfeld = ""
mData3(nCnt3)(0)=""
mData3(nCnt3)(1)=""
nCnt3=nCnt3+1
' WENN nicht LEER,
ElseIf mData2(nCnt3,0) >= 0 AND mData2(nCnt3,1) >= 0 Then
' Wen Zähler > uBound(mData3())
If nCnt3 >nUB Then Exit For
' DANN Spalte "A" inkrementieren
mData3(nCnt3)(0) = nCnt2
If nCnt1 = 1 Then
mData3(nCnt3)(1) = fTime+fSekunde ' Zeit für Zelle B5
Else
mData3(nCnt3)(1) = fTime+mData2(nCnt3)(0) 'Zeitberechnung bis letzte Zeile
End IF
' Zähler inkrementieren
nCnt2=nCnt2+1
nCnt3=nCnt3+1
End If
Next nCnt1
mData3(0)(1)=oSheetAusVorlage.getCellRangeByName("$B$2").Value
' oSheetAusVorlage.getCellRangeByName("$A$4:$B$23").setDataArray(mData3())
oSheetAusVorlage.getCellRangeByPosition(0,3,1,nEndRow1).setDataArray(mData3())
REM ----------------------------------------------------------------------------------------------------------------------------------------------
REM Zellen formatieren mit Formatcode 41 = HH:MM:SS → 12:12:10
REM https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1i18n_1_1NumberFormatIndex.html
oSheetAusVorlage.getCellRangeByName("B2:C2").NumberFormat=41
' oSheetAusVorlage.getCellRangeByName("B4").NumberFormat=41
oSheetAusVorlage.getCellRangeByName("B4:C86410").NumberFormat=41
REM ...................................
REM CSV-Datei schließen
oDocCSV.Close(True)
Msgbox "Programmende: 'Sub [CSV_DATEN importieren]'" & Chr(10) & _
"______________________________" & Chr(10) & Chr(10) & _
"Es wurden " & nCnt3 & " Datensätze geschrieben.", 64,"Programmende"
REM End If
Exit Sub
REM ...................................
ErrorHandler:
Reset
MsgBox "Die CSV-Datei" & Chr(10) & _
sPath & Chr(10) & _
"ist bereits geöffnet" & Chr(10) & _
"Bitte schließen Sie die Datei und starten das Programm erneut" & Chr(10) & _
"______________________________" & Chr(10) & Chr(10) & _
"Das Programm wird beendet!" ,0,"Fehlermeldung"
REM CSV-Datei schließen
XClose
End Sub
Sub XClose
dim i As Integer
dim ncnt1
dim z
dim y
REM CSV-Datei schließen
'xray
nCnt1=Stardesktop.Frames.Count
for i = 0 to nCnt1-1
z=Stardesktop.Frames.getByIndex (i).Title
y=left(z,4)
if y="Hans" then
Msgbox "Die CSV-Datei 'Hans_Meerkatz*.CSV' ist bereits geöffnet und wird nun geschlossen!" & cHR(10) &_
"Das Programm wird beendet!",64, "Fehlerroutine:"
Stardesktop.Frames.getByIndex (i).Controller.Frame.Close(True)
exit For
end if
Next i
End Sub
