opslaan als CSV zoals Open Office

[pelikano]

Hallo,
is er al iemand die een opslaan als functie/macro heeft om een Excelbestand op te slaan als CSV zoals OpenOffice dat doet? Even om de discussie te voorkomen: OpenOffice slaat een CSV anders op dan Excel.
Ik heb deze functie nodig om vanuit Excel een export te kunnen doen voor een applicatie die alleen maar het OpenOffice CSV formaat in kan lezen.

Open Office voorbeeld; 
"K1","K2","K3","K4","K5","K6","K7","K8","K9","K10","K11"
I1,I2,I3,I4,I5,I6,"Dit hoort bij elkaar",I8,I9,I10,
I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,

Excel voorbeeld;
K1;K2;K3;K4;K5;K6;K7;K8;K9;K10;K11
I1;I2;I3;I4;I5;I6;Dit hoort bij elkaar;I8;I9;I10;
I1;I2;I3;I4;I5;I6;I7;I8;I9;I10;

 

[Breuk132]

Hallo,

Probeer deze eens.

Als locale computer instellingen Nederlands zijn

ActiveWorkbook.SaveAs "c:\helpmij\text.csv", xlCSV, , , , , , ,,, , , False

Of

Als locale computer instellingen Engels/Vs zijn

ActiveWorkbook.SaveAs "c:\helpmij\text.csv", xlCSV, , , , , , ,,, , , True

 

[pelikano]

Hallo Jeltje,
bedankt voor je snelle reactie.

Ik heb de regel in een macro gezet maar krijg een foutmelding: Onjuist aantal argumenten of onvoldoende eigenschaptoewijzing

Ik kan de functie ook niet in mijn help terugvinden.

 

[pelikano]

Inmiddels heb ik wel een stuk code gevonden om een bestand als CSV op te slaan. Deze werkt maar geeft nog steeds resultaat uit voorbeeld 2. Hoe kan ik onderstaande ombouwen dat het voorbeeld 2 maakt?

Deze macro geeft als resultaat;

K1,K2,K3,K4,K5,K6,K7,K8,K9,K10,K11
I1,I2,I3,I4,I5,I6,Dit hoort bij elkaar,I8,I9,I10,
I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,

Sub subExportCSV()
On Error GoTo subexport_exit
    Dim strDelimiter As String
    strDelimiter = ","
    Dim strQualifier As String
    strQualifier = ""
 
 
    Dim arrRng
    arrRng = ActiveSheet.UsedRange.Value
    Dim f As String
    Dim i As Long
    Dim j As Long
    Dim strTemp As String
    
    f = InputBox("Enter a filename for saving", , "C:\test.csv")
    If Trim(f) = "" Then Exit Sub
    Open f For Output As #1
    For i = 1 To UBound(arrRng, 1)
        strTemp = ""
        For j = 1 To UBound(arrRng, 2)
            strTemp = strTemp & strQualifier & arrRng(i, j) & strQualifier & strDelimiter
        Next j
        Print #1, Left(strTemp, Len(strTemp) - Len(strDelimiter))
    Next i
    
subexport_exit:
    Close #1
End Sub

En dit zou het moeten worden;

"K1","K2","K3","K4","K5","K6","K7","K8","K9","K10","K11"
I1,I2,I3,I4,I5,I6,"Dit hoort bij elkaar",I8,I9,I10,
I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,

 

[danvie]

Hoi Pelikano,

Volgens mij moet het met onderstaande lukken.

Sub Opslaan_als_CSV()
'
' Opslaan_als_CSV Macro
' Opslaan als CSV in memomap op C voor import navision
'
' Sneltoets: CTRL+q
'
Dim objBereik As Object, DoelRij As Object, Cel As Object
Dim strTemp As String
Dim strDataNaam As String
Dim strKoppelteken As String
Dim strMapPad As String
    
    
    ChDir "C:\INTERFACE\MEMO"
    If Len(Dir("C:\INTERFACE\MEMO\*.*")) > 0 Then
    Kill "C:\INTERFACE\MEMO\*.*"
    End If


strMapPad = "C:\INTERFACE\MEMO\MEMO.csv"

strDataNaam = InputBox("Naam voor de CSV data (incl. Pad)?", "CSV-Export", strMapPad)
If strDataNaam = "" Then Exit Sub

strKoppelteken = InputBox("Welk splitsteken zal gebruikt worden?", "CSV-Export", ";")
If strKoppelteken = "" Then Exit Sub

Set objBereik = ActiveSheet.UsedRange

Open strDataNaam For Output As #1

For Each DoelRij In objBereik.Rows
For Each Cel In DoelRij.Cells
If InStr(1, Cel.Text, strKoppelteken) > 0 Then
'Cellen met splitsteken in rij zetten
strTemp = strTemp & """" & CStr(Cel.Text) & """" & strKoppelteken
Else
strTemp = strTemp & CStr(Cel.Text) & strKoppelteken
End If
Next
If Right(strTemp, 1) = strKoppelteken Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereik = Nothing
MsgBox "Data geexporteerd naar" & vbCrLf & strDataNaam

End Sub

Ik heb dit al eens gebruikt om het juiste formaat te creeeren en in te kunnen lezen.
Door middel van speurwerk en wat eigen aanpassingen heb ik dit in elkaar gezet.
Er zitten een aantal variabelen in die je eenvoudig kunt aanpassen.

veel succes.

Daniel

 

[pelikano]

Bedankt Daniel,
ik heb het uitgeprobeerd werkt leuk maar het lastige zit in de eerste regel in het voorbeeld, die wijkt af van de rest. String aanpassen lukt mij nog wel maar helaas heb ik niet zoveel code ervaring dat ik het kan verbouwen.

 

[danvie]

Pelikano,

Dat had ik net even gemist.
Dat gaat mij helaas ook net iets te ver.
Ik kan wel wat simpele aanpassingen maken maar dan houdt het op.
Misschien dat de experts er nog iets van kunnen maken.

Succes verder.

 

[pelikano]

Jammer,
ik hoop dat er een expert mijn voorgestelde macro kan bekijken. Door in de eerste macro de strQualifier aan te passen naar strQualifier = """" krijg ik wel een goede eerste regel maar de rest van de cellen wordt dan ook voorzien van quote's.
Alleen bij elkaar horende tekst moeten quote's hebben.