CSV bestand maken voor importeren in Outlook

Status
Niet open voor verdere reacties.
T

Tweety1

Gebruiker
Lid geworden
6 mrt 2013
Berichten
637
Onderstaande vba gebruik ik om een excel bestand op te slaan als csv met tekst tussen aanhalingstekens ("").
Alleen loop ik er tegen het volgende aan.
De kolom "Beschrijving" bevat tekst met terugloop (alt+enter). Bij het opslaan als csv komt er dubbele aanhalingsteken ("") aan het begin en einde.
Door die dubbele "" gaat het mis met importeren in outlook (neemt alleen de eerste regel mee).
Hoe kan ik de vba aanpassen zodat er maar 1 " aanhalingsteken komt te staan bij de inhoud van de cel beschrijving


VBA:
Code: 
Sub ExporterenCSV()
Dim c As Long, varItems() As Variant ' must be 0-based variant array
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
Range(ActiveSheet.ListObjects(1).Name).CurrentRegion.Copy
  
   With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
      .GetFromClipboard
      CreateObject("scripting.filesystemobject").createtextfile(ThisWorkbook.Path & "\" & ActiveSheet.Name & ".csv").write Chr(34) & Replace(Replace(.GetText, vbTab, Chr(34) & "," & Chr(34)), vbCrLf, Chr(34) & vbCrLf & Chr(34))
      .Clear
    End With
    
Application.CutCopyMode = False

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
             
End Sub

CSV (rood hoort 1 te zijn:
Code: 
"Onderwerp","Begindatum","Begintijd","Einddatum","Eindtijd","Gebeurtenis, duurt hele dag","Herinneringen aan/uit","Beschrijving","Categorieën","Locatie","Prioriteit","Privé"
"Test 1","7-4-2017","9:00","7-4-2017","9:30","","JA","[COLOR="#FF0000"]"[/COLOR]Regel 1
Regel 2
Regel 3[COLOR="#FF0000"]"[/COLOR]","","","HOOG",""
"

Voorbeeld:
Bekijk bijlage Export Agenda voorbeeld.xlsm

mvg
Kasper
 
Dat komt door de CRLF tekens in die cel.
Zo doet 'ie het prima:
Code: 
Sub ecsv()
    Application.ScreenUpdating = False
    Sheets("agenda").Copy
    With ActiveWorkbook
        .SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, Local:=True
        .Close
    End With
    Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
Ik loop alleen tegen het volgende probleem aan.
In het gemaakte bestand staat de datum als 6/1/2017. Bij het importeren in outlook ziet outlook dit als 6 januari in plaats van 6 juni.
Is het mogelijk om de datum op te slaan als 01-06-2017
 
6/1/2017 is in Nederland ook 6 januari.
Plaats je document eens.
 
Waarom gebruik je niet ipv

Code: 
Range(ActiveSheet.ListObjects(1).Name).CurrentRegion.Copy

Code: 
ActiveSheet.ListObjects(1).databodyrange.Copy
 
edmoor zei:
Plaats je document eens.
Klik om te vergroten...
Dat staat al in bericht #1 :).
En de datum wordt in jouw ed's code inderdaad gelezen als een Amerikaanse datum, en dan heb je een probleem want 7-4 is uiteraard niet hetzelfde als 4-7. Daarnaast hou je het probleem van de regels die niet kloppen.
Ik denk dat je nog een extra replace in je code moet bouwen die de regeleinde (Chr(10)) vervangt door een nader te bepalen teken.
 
Tweety1 zei:
Herbij de voorbeeld bestanden
Klik om te vergroten...

Bij mij is dit het resultaat:
Test 1;1-6-2017;9:00;1-6-2017;9:30;;JA;"Regel 1Regel 2Regel 3";;;HOOG;

Staat je systeem in de regionale instellingen wel op Nederland?
 
Laatst bewerkt:
Systeem staat wel in het Nederlands heb er vaker problemen mee gehad.
Kan niet wijzigen ivm blokkades.
 
Kennelijk staat de datum- en tijd notatie dan niet in het Nederlands. Ook je veldscheidingsteken is Amerikaans.
 
Check met:

Code: 
Sub M_snb()
    With Application
        MsgBox .International(xlDateSeparator) & vbLf & .International(xlListSeparator) & vbLf & .International(xlRowSeparator)
    End With
End Sub
 
Hier hetzelfde. Maar bij mij geeft de export naar CSV het juiste resultaat. Je zal dus toch even naar die instellingen moeten (laten) kijken. Het gaat met name om dit:

Region.jpg Numbers.jpg
 
Instellingen staan goed.
Heb stukje vba toegevoegd.

Code: 
    Sub Test()
    Dim LaatsteCel As Long
    Application.ScreenUpdating = False
    Sheets("agenda").Copy
    With ActiveWorkbook

    LaatsteCel = Range("A" & Rows.Count).End(xlUp).Row

    Set Myrange = Range("B2:D" & LaatsteCel)
    For Each Cell In Myrange
        s = Cell.Text
        Cell.NumberFormat = "@"
        Cell.Value = s
    Next Cell

        .SaveAs Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, Local:=True
        .Close
    End With
    Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
Die code is goed en levert bij mij nog steeds dit:
Test 1;7-4-2017;9:00;7-4-2017;9:30;;JA;"Regel 1Regel 2Regel 3";;;HOOG;

Kijk eens wat er gebeurt als je die , Local:=True weg laat.
Ik verwacht dan geen verandering.
 
Laatst bewerkt:
gebruik eens
Code: 
Sub M_snb()
    Sheets("agenda").Copy
    With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\voorbeeld_021.txt", 21
        .SaveAs ThisWorkbook.Path & "\voorbeeld_006.csv", 6
        .SaveAs ThisWorkbook.Path & "\voorbeeld_024.csv", 24
        .SaveAs ThisWorkbook.Path & "\voorbeeld_003.csv", 3
    end with
End Sub
en bekijk de resultaten in kladblok (niet in Excel !!).
 
Laatst bewerkt:
Uitkomst in kladblok is het zelfe gebleven.
Heb wel iet aan de vba gewijzigd gaf rode regels op saveas regels

Code: 
Sub M_snb()
    Sheets("agenda").Copy
    With ActiveWorkbook
        .SaveAs FileName:=ThisWorkbook.Path & "\" & ActiveSheet.Name & "_021.txt", FileFormat:=21
        .SaveAs FileName:=ThisWorkbook.Path & "\" & ActiveSheet.Name & "_006.csv", FileFormat:=6
        .SaveAs FileName:=ThisWorkbook.Path & "\" & ActiveSheet.Name & "_024.csv", FileFormat:=24
        .SaveAs FileName:=ThisWorkbook.Path & "\" & ActiveSheet.Name & "_003.csv", FileFormat:=3
    End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan