Projekt-Anfragen: Tel: 07022/9319004 info@CodeDocu.de Software Entwicklung in C# WPF Asp.Net Core Vba Excel Word SQL-Server EF Linq, UWP Net
#

Excel Speichern als .CSV mit Semikolon zeichen

 

Wenn man Excel in vba Makro als CSV Datei speichert, dann wird die Liste mit Komma ausgegeben.

Hierzu muss man zur Korrektur bei SaveAs den Paramater Local auf True setzen und bei anschliessenden Close SaveChanges auf false

 

 

    If bSaveas_Csv Then

        objExcel.SaveAs sFilename_full, XlFileFormat.xlCSV, Local:=True

        objExcel.Close SaveChanges:=False

        MsgBox "Die Datei wurde als .csv gespeichert.." & vbCrLf & sFilename_full, vbOKOnly

    Else

        objExcel.Close SaveChanges:=True, Filename:=sFilename_full

    End If

    '--</ speichern >--

   

 

 

 

 

 

 

Für die Verwendung beim Öffnen einer Excel Datei muss man die lokalen Einstellungen anpassen

 

Hierzu unter den älteren Systemen auf Systemsteuerung

Dann Region und Sprache

 

Dann Formate->Weitere Einstellungen->Listentrennzeichen

 

 

 

Option Compare Database

Option Explicit On

 

 

'=========================================< FUNKTIONEN >=========================================

 

Public Sub fp_EXCEL_Ausgabe(ByVal parQueryname As String, Optional ByVal sFilename As String, Optional ByVal sSheetname As String, Optional ByVal Opt_As_Csv As Boolean)

    '--------------------< fp_EXCEL_Ausgabe() >--------------------

    '----< Excel bearbeiten >----

    '*qryShow_Project_Responses_InForm

 

    '< create >

    'Dim appExcel As Excel.Application

    Dim objExcel As Excel.Workbook

    Set objExcel = Workbooks.Add

    '</ create >

   

    '< Filename festlegen >

    Dim sLabel As String

    If Not IsMissing(sFilename) Then

        sLabel = sFilename

    Else

        sLabel = "Liste_" & Format(Of Date, "yyyy-MM-dd")

    End If

 

    '</ Filename festlegen >

 

 

    Dim objSheet As Excel.Worksheet

    Set objSheet = objExcel.Worksheets(1)

    If Not IsMissing(sSheetname) Then

        objSheet.Name = sSheetname

    End If

 

    Dim sSQL As String

    sSQL = CurrentDb.QueryDefs(parQueryname).SQL

 

    Dim qry As QueryDef

    Set qry = CurrentDb.QueryDefs(parQueryname)

    Dim par As Parameter

    For Each par In qry.Parameters

        If par.Name Like "*frm_Orders_Versand*ctlListe*" Then

            par.Value = Forms("frm_Orders_Versand")!ctlListe

        ElseIf par.Name Like "*ctlDtErfassung*" Then

            par.Value = Forms("frm_Projects_Responses")!ctlDtErfassung

            sLabel = sLabel & "_KW" & Format(par.Value, "ww")

        ElseIf par.Name Like "IDProject" Then

 

        End If

    Next

    Dim rec As Recordset

    On Error Resume Next

    Set rec = qry.OpenRecordset(dbOpenSnapshot)

    If Err.Number <> 0 Then

        MsgBox Err.Description

        Set rec = Nothing

        Exit Sub

    End If

    If Not rec.EOF Then

        '--------< hat Records >--------

        Dim nRecordcounts As Long

        rec.MoveLast

        nRecordcounts = rec.RecordCount

        rec.MoveFirst

 

 

 

        '< init >

        Dim iField As Long

        Dim iFieldmax As Long

        iFieldmax = rec.Fields.Count

 

        Dim iRow As Long

        iRow = 1

        '</ init >

 

        '--< Header ausgeben >--

        For iField = 0 To iFieldmax - 1

            objSheet.Cells(1, iField + 1).Value = rec.Fields(iField).Name

        Next

        '--</ Header ausgeben >--

        '----< @Loop: Zeilen >----

        Do Until rec.EOF

            '----< ZEile >----

            iRow = iRow + 1

            DoEvents

 

            DoCmd.Echo True, "row " & iRow & " von " & nRecordcounts

            '--< rec.Zellen ausgeben >--

            For iField = 0 To iFieldmax - 1

                objSheet.Cells(iRow, iField + 1).Value = rec.Fields(iField).Value

            Next

            '--</ rec.Zellen ausgeben >--

 

            rec.MoveNext

            '----</ ZEile >----

        Loop

        '----</ @Loop: Zeilen >----

        '--------</ hat Records >--------

    End If

 

 

    '< Saveformat ermitteln >

    Dim bSaveas_Csv As Boolean

    bSaveas_Csv = False

 

    If IsMissing(Opt_As_Csv) = False Then

        If Opt_As_Csv = True Then

            bSaveas_Csv = True

        End If

    End If

    '</ Saveformat ermitteln >

 

 

 

    '--< speichern >--

    Dim sPath As String

    sPath = CurrentProject.Path

    sPath = sPath & "\_export"

 

    '< Ordner pruefen und erstellen >

    Dim fs As New FileSystemObject

    If fs.FolderExists(sPath) = False Then

        fs.CreateFolder sPath

    End If

    '< Ordner pruefen und erstellen >

 

    '< Ausgabe_Pfad und Name festlegen >

    Dim sFilename_full As String

    If bSaveas_Csv Then

        sFilename_full = sPath & "\Versandlisten_DHL_csv\" & sLabel

    Else

        sFilename_full = sPath & "\" & sLabel

    End If

    '</ Ausgabe_Pfad und Name festlegen >

 

    On Error Resume Next

 

 

    If bSaveas_Csv Then

 

        objExcel.SaveAs sFilename_full, XlFileFormat.xlCSV, Local:=True

        objExcel.Close SaveChanges:=False

        MsgBox "Die Datei wurde als .csv gespeichert.." & vbCrLf & sFilename_full, vbOKOnly

    Else

        objExcel.Close SaveChanges:=True, Filename:=sFilename_full

    End If

    '--</ speichern >--

   

    '</ Abschluss >

    '*unbedingt schliessen...

    Set objExcel = Nothing

    '</ Abschluss >

   

    '< oeffnen >

    If bSaveas_Csv Then

        Shell "explorer.exe " & sPath & "\Versandlisten_DHL_csv\"

    Else

        Shell "Excel.exe " & sFilename_full & ".xlsx"

    End If

    '</ oeffnen >

 

    '----</ Excel bearbeiten >----

 

    '--------------------</ fp_EXCEL_Ausgabe() >--------------------

End Sub

 

 

Public Sub fp_EXCEL_Ausgabe_Barcode(ByVal parQueryname As String, Optional ByVal sFilename As String, Optional ByVal sSheetname As String)

    '--------------------< fp_EXCEL_Ausgabe() >--------------------

    '----< Excel bearbeiten >----

    '*qryShow_Project_Responses_InForm

 

    '< create >

    'Dim appExcel As Excel.Application

    Dim objExcel As Excel.Workbook

    Set objExcel = Workbooks.Add

    '</ create >

   

    '< Filename festlegen >

    Dim sLabel As String

    If Not IsMissing(sFilename) Then

        sLabel = sFilename

    Else

        sLabel = "Liste_" & Format(Of Date, "yyyy-MM-dd")

    End If

 

    '</ Filename festlegen >

 

 

    Dim objSheet As Excel.Worksheet

    Set objSheet = objExcel.Worksheets(1)

    If Not IsMissing(sSheetname) Then

        objSheet.Name = sSheetname

    End If

 

    Dim sSQL As String

    sSQL = CurrentDb.QueryDefs(parQueryname).SQL

 

    Dim qry As QueryDef

    Set qry = CurrentDb.QueryDefs(parQueryname)

    Dim par As Parameter

    For Each par In qry.Parameters

        If par.Name Like "*frm_Orders_Versand*ctlListe*" Then

            par.Value = Forms("frm_Orders_Versand")!ctlListe

        ElseIf par.Name Like "*ctlDtErfassung*" Then

            par.Value = Forms("frm_Projects_Responses")!ctlDtErfassung

            sLabel = sLabel & "_KW" & Format(par.Value, "ww")

        ElseIf par.Name Like "IDProject" Then

 

        End If

    Next

    Dim rec As Recordset

    On Error Resume Next

    Set rec = qry.OpenRecordset(dbOpenSnapshot)

    If Err.Number <> 0 Then

        MsgBox Err.Description

        Set rec = Nothing

        Exit Sub

    End If

    If Not rec.EOF Then

        '--------< hat Records >--------

        Dim nRecordcounts As Long

        rec.MoveLast

        nRecordcounts = rec.RecordCount

        rec.MoveFirst

 

 

 

        '< init >

        Dim iField As Long

        Dim iFieldmax As Long

        iFieldmax = rec.Fields.Count

 

        Dim iRow As Long

        iRow = 1

        '</ init >

 

        '--< Header ausgeben >--

        For iField = 0 To iFieldmax - 1

            objSheet.Cells(1, iField + 1).Value = rec.Fields(iField).Name

        Next

        '--</ Header ausgeben >--

        '----< @Loop: Zeilen >----

        Do Until rec.EOF

            '----< ZEile >----

            iRow = iRow + 1

            DoEvents

 

            DoCmd.Echo True, "row " & iRow & " von " & nRecordcounts

            '--< rec.Zellen ausgeben >--

            For iField = 0 To iFieldmax - 1

                objSheet.Cells(iRow, iField + 1).Value = rec.Fields(iField).Value

            Next

            '--</ rec.Zellen ausgeben >--

            Dim iPos As Integer

            iPos = InStr(1, sFilename, "_ORDERS_", vbTextCompare)

            iPos = iPos + Len("_")

            sFilename = Mid(sFilename, iPos) & ".csv"

            Dim sID As Long

            sID = DLookup("IDImport_Orders_File", "tbl_Orders_Masterfiles", "Filename like '" & sFilename & "'")

 

            Dim sEncode_Text As String

            sEncode_Text = sID & "_" & objSheet.Cells(iRow, 9).Text

 

            '< barCode >

            create_Barcode39_via_Clipboard objSheet, objSheet.Cells(iRow, 12), sEncode_Text

            '</ barCode >

 

            rec.MoveNext

            '----</ ZEile >----

        Loop

        '----</ @Loop: Zeilen >----

        '--------</ hat Records >--------

    End If

 

 

 

    '--< speichern >--

    Dim sPath As String

    sPath = CurrentProject.Path

    sPath = sPath & "\_export"

 

    '< Ordner pruefen und erstellen >

    Dim fs As New FileSystemObject

    If fs.FolderExists(sPath) = False Then

        fs.CreateFolder sPath

    End If

    '< Ordner pruefen und erstellen >

 

    Dim sFilename_full As String

    sFilename_full = sPath & "\" & sLabel

    On Error Resume Next

    objExcel.Close SaveChanges:=True, Filename:=sFilename_full

    '--</ speichern >--

   

    '</ Abschluss >

    '*unbedingt schliessen...

    Set objExcel = Nothing

    '</ Abschluss >

   

    '< oeffnen >

    Shell "Excel.exe " & sFilename_full & ".xlsx"

    '</ oeffnen >

 

    '----</ Excel bearbeiten >----

 

    '--------------------</ fp_EXCEL_Ausgabe() >--------------------

End Sub

'=========================================</ FUNKTIONEN >=========================================

 

 

Mobile
»
Excel: Wandle Buchstaben in Ascii Zahlen um
»
Excel: Wandle Buchstaben in Ascii Zahlen um
»
Excel Speichern als .CSV mit Semikolon zeichen
»
Vba Makro Code: So erstellt man ein Excel Workbook und Sheet zur Laufzeit ohne Excel Verweis
»
Office Verzeichnis Dialog ohne Verweis auf ObjectLibrary
»
Ändern von vba Code zu Late Binding ohne dll-Verweis Dim Excel Word as Object
»
Excel Datei mit Schutz mit erlaubtem Farbformatierungen, Kommentaren und Sperren von Formelfeldern
»
Excel vba Fehler: Laufzeitfehler 1004 Die Locked-Eigenschaft des Range-Objektes kann nicht festgelegt werden
»
Excel Datei schützen
»
Excel Blatt schützen: Protect Parameter

.

Jobs, Projekte, Angebote für Freiberufler, Selbstständig an Info@CodeDocu.de