REM  *****  BASIC  *****
REM modCSVImport
Sub [CSV_DATEN importieren]
Dim oSD as Object
Dim oFrames as Object
Dim oFrame as Object
Dim nCnt1 as Long

Dim oDocCSV as Object  
Dim oSheet as Object
Dim oRange1 as Object
Dim oRange2 as Object

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 mPath as Variant

Dim vDate as Variant
Dim sDate as String	
Dim mDate as Variant


Dim sFileCSV as String
Dim sPath as String
Dim sFile as String

Dim oDocAusVorlage as Object
Dim oSheetAusVorlage as Object
Dim oRange1AusVorlage as Object
Dim oRange2AusVorlage as Object
Dim oRange3AusVorlage as Object

Dim bFound as Boolean

	oDocAusVorlage=ThisComponent

		oSheetAusVorlage=oDocAusVorlage.CurrentController.ActiveSheet
			oRange1AusVorlage=oSheetAusVorlage.getCellRangeByName("A2:C2")
			oRange2AusVorlage=oSheetAusVorlage.getCellRangeByName("B4: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:///C:/temp 2021/Natal-Neu Makro/"

		sFile=dir(sUrl & "Hans*.csv")
			sPath = convertFromUrl(sUrl) & sFile
				
'			msgbox sPath
			
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
	
	If bFound=False Then

REM -----------------------------------------------------------------------------------------------------
REM Prüfung ob die Datei existiert.
REM Dazu wird die "Function CheckForFile()" aufgerufen;
REM "Function CheckForFile()" = TRUE		' Datei existiert
REM "Function CheckForFile()" = FALSE		' Datei existiert nicht oder der Dateiname ist falsch, bzw.
REM der Dateiname entspricht nicht den Vorgaben, welche von diesem Makro gefordert werden
	If CheckForFile(sPath) Then
		' "Function CheckForFile()" = TRUE
'		msgBox sPath
	Else
		' "Function CheckForFile()" = 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) 'show_open_dialog
    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 = "59,34,76,1,,0,false,true,true,false"
		' Datei im Hintergrund öffnen
        mFileProps(2).Name = "Hidden"		: mFileProps(2).Value = False
        oDocCSV = StarDesktop.loadComponentFromURL(sFileCSV, "_blank", 0, mFileProps())        
    end if

REM 			...................................
REM Daten aus dem CSV-File kopieren

	oSheet=oDocCSV.CurrentController.ActiveSheet
		oRange1=oSheet.getCellRangeByName("C2:E2")
		oRange2=oSheet.getCellRangeByName("B4:C86410")
		oRange3=oSheet.getCellRangeByName("A4:A86410")
			mData1()=oRange1.getDataArray()
			mData2()=oRange2.getDataArray()
			mData3()=oRange3.getDataArray()

		oSheetAusVorlage.getCellRangeByName("A2:C2").setDataArray(mData1())
		oSheetAusVorlage.getCellRangeByName("B4:C86410").setDataArray(mData2())
REM 			...................................
REM Zellformat 41 = 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:B86410").NumberFormat=41

REM 			...................................
REM Zähler für Spalte A
Dim oCellCursor as Object
Dim nEndRow as Long

			oCellCursor = oSheetAusVorlage.createCursor()
   			oCellCursor.GotoEndOfUsedArea(True)
	
			nEndRow = oCellCursor.getRangeAddress.EndRow+1
				For nCnt1 = 1 To nEndRow-3
					mData3(nCnt1-1)(0)=nCnt1
				Next nCnt1
		oSheetAusVorlage.getCellRangeByName("A4:A86410").setDataArray(mData3())
'		msgbox nEndRow

REM 			...................................
REM CSV-Datei schließen
	oDocCSV.Close(True)
exit Sub
End If

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"

End Sub

REM -------------------------------------------------------------------------------------------------
REM 				Prüfen ob Datei existiert
REM -------------------------------------------------------------------------------------------------
REM  "aPath" enthält die Pfadangabe inklusive des Dateinamens
REM  "CheckForFile" liefert TRUE zurück, falls die Datei existiert
REM  andernfalls liefert "CheckForFile" FALSE
Function CheckForFile(aPath as String ) as Boolean
Dim CurrentFileName as string

	CheckForFile = FALSE

	CurrentFileName = DIR( aPath, 0 )
		While CurrentFileName <> ""
			If InStr(1, CurrentFileName, aCode) <> 0 Then
				CheckForFile = TRUE
        Exit Function
     End If
    CurrentFileName = DIR
  Wend
     
End Function