Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1280to1284
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

CSV Datei , mit Semikolon speichern

CSV Datei , mit Semikolon speichern
23.10.2012 12:33:09
rene
Hallo zusammen
ich versuche eine CSV datei aus Excel heraus mit lotus notes zu versenden , funktioniert soweit auch , Probleme habe ich damit das csv file als semikolon getrennt zu speichern. Hat jemand eien Idee wie der Code geändert werden sollte?
Sub send()
Dim stFileName As String
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim strDateiname As String
Dim strAntwort As String
' "Worksheet ASN soll als CSV Semikolon getrennt gepeichert werden "
'Copy the active sheet to a new temporarily workbook.
With Worksheets("ASN").Copy
strDateiname = "sjj_asn_" & Range("B1").Value & Format(Now, "_yyyy_mm_dd_hhmm") & ".csv"
'With ActiveSheet
'.Copy
'stFileName = .Range("A1").Value
End With
stAttachment = stPath & "\" & strDateiname '& ".csv"
'Save and close the temporarily workbook.
With ActiveWorkbook
'.SaveAs stAttachment
.SaveAs ("C:\Attachments\" & strDateiname), FileFormat:=xlCSV, local:=True
End With
'Create the list of recipients.
vaRecipients = VBA.Array("test@test.com", "")
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.form = "Memo"
.SendTo = vaRecipients
' .CopyTo = vaCopyTo
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With
'Delete the temporarily workbook.
Kill stAttachment
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "The e-mail has successfully been created and distributed", vbInformation
End Sub

Grüße Rene

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: CSV Datei , mit Semikolon speichern
23.10.2012 13:06:24
Rudi
Hallo,

'Copy the active sheet to a new temporarily workbook.
strDateiname = "sjj_asn_" & Range("B1").Value & Format(Now, "_yyyy_mm_dd_hhmm") & ".csv"
prcCreateCSV Sheets("ASN"), "C:\Attachments\" & strDateiname
'Create the list of recipients.
Public Sub prcCreateCSV(wks As Worksheet, strName As String)
Dim intFileNumber As Integer
Dim lngRow As Long
Dim vntArray As Variant
Dim intItem As Integer
Dim strText As String
Dim i As Integer
Const strSep As String = ";"
With wks.UsedRange
For lngRow = 1 To .Rows.Count
vntArray = .Cells(lngRow, 1).Resize(, .Columns.Count)
vntArray = WorksheetFunction.Transpose(vntArray)
vntArray = WorksheetFunction.Transpose(vntArray)
If strText = "" Then
strText = Join(vntArray, strSep)
Else
strText = strText _
& vbCrLf _
& IIf(lngRow = .Rows.Count, Join(vntArray, ";"), Join(vntArray, strSep))
End If
Next
End With
intFileNumber = FreeFile
Open strName For Output As #intFileNumber
Print #intFileNumber, strText
Close #intFileNumber
End Sub

Gruß
Rudi

Anzeige
AW: CSV Datei , mit Semikolon speichern
23.10.2012 14:50:39
rene
Danke Rudi
Stell mich wohl blöd an bekomme es nicht ans laufen .
bei prcCreateCSV (Fehler SUB,Funktion oder Proberty erwartet )was mache ich denn da falsch?
habe sub speichern im Modul gespeichert ist das richtig ?
-----------------------------------------------------------------------------------
'Copy the active sheet to a new temporarily workbook.
With Worksheets("ASN").Copy
strDateiname = "sjj_asn_" & Range("B1").Value & Format(Now, "_yyyy_mm_dd_hhmm") & ".csv"
prcCreateCSV Sheets("ASN"), "C:\Attachments\" & strDateiname
'With ActiveSheet
'.Copy
'stFileName = .Range("A1").Value
End With
stAttachment = stPath & "\" & strDateiname '& ".csv"
'Save and close the temporarily workbook.
With ActiveWorkbook
---------------------------------------------------------------------------
Sub speichern()
Dim prcCreateCSV As String
Dim strDateiname As String
Dim strAntwort As String
Worksheets("ASN").Copy
'strDateiname = Range("B1").Value & Format(Date, "_dd_mm_yy") & ".csv"
strDateiname = Range("B1").Value & Format(Now, "_yyyy_mm_dd_hhmm") & "sjj_asn.csv"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'ActiveSheet.SaveAs ("C:\Dokumente und Einstellungen\derbbrsa\Desktop\China ASN\ASN\" & strDateiname), FileFormat:=xlCSV, local:=True
ActiveSheet.SaveAs ("C:\ASN\" & strDateiname), FileFormat:=xlCSV, local:=True
ActiveWorkbook.Close False
'Const vaCopyTo As Variant = ""
'Sub Send_Active_Sheet()
Dim stFileName As String
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
'Dim strDateiname As String
'Dim strAntwort As String
'----------------------------------------------------------------------------------
'Sub speichern()
'Dim strDateiname As String
'Dim strAntwort As String
'Worksheets("ASN").Copy
'strDateiname = Range("B1").Value & Format(Date, "_dd_mm_yy") & ".csv"
'strDateiname = Range("B1").Value & Format(Now, "_yyyy_mm_dd_hhmm") & ".csv"
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
'ActiveSheet.SaveAs ("C:\Dokumente und Einstellungen\derbbrsa\Desktop\China ASN\ASN\" & strDateiname), FileFormat:=xlCSV, local:=True
'ActiveWorkbook.Close False
'End Sub '-------------------------------------------------------------------------------------------
'Copy the active sheet to a new temporarily workbook.
With Worksheets("ASN").Copy
strDateiname = "sjj_asn_" & Range("B1").Value & Format(Now, "_yyyy_mm_dd_hhmm") & ".csv"
prcCreateCSV Sheets("ASN"), "C:\Attachments\" & strDateiname
'With ActiveSheet
'.Copy
'stFileName = .Range("A1").Value
End With
stAttachment = stPath & "\" & strDateiname '& ".csv"
'Save and close the temporarily workbook.
With ActiveWorkbook
'-----------------------------------------------------------------------------
'------------------------------------------------------------------------------
'.SaveAs stAttachment
.SaveAs ("C:\Attachments\" & strDateiname) ', FileFormat:=xlCSV, local:=True
.Close
End With
'Create the list of recipients.
vaRecipients = VBA.Array("sagorski.rene@recticel.com") ', "DeKimpe.Michel@recticel.com")
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.form = "Memo"
.SendTo = vaRecipients
' .CopyTo = vaCopyTo
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With
'Delete the temporarily workbook.
Kill stAttachment
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "The e-mail has successfully been created and distributed", vbInformation
End Sub
'Sub SaveCSV()
'Dim Bereich As Object
'Dim Zeile As Object
'Dim Zelle As Object
'Dim strTemp As String
'Const Pfad As String = "C:\asn\"
'Const Dateiname As String = "test"
'Const Extension As String = ".CSV"
'Const Trennzeichen As String = ";"
'Const Kapselzeichen As String = """"
'Hier kann auch ein eigener Range angegeben werden
'Set Bereich = ActiveSheet.Range("A1:B5")
'Set Bereich = ActiveSheet.UsedRange
'Open Pfad & Dateiname & Extension For Output As #1
'For Each Zeile In Bereich.Rows
' For Each Zelle In Zeile.Cells
' If InStr(1, Zelle.Text, Trennzeichen) > 0 Then 'angepasst T.Ramel
' 'Zellen, die ein Trennzeichen beinhalten in Kapselzeichen setzen
' strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _
' Kapselzeichen & Trennzeichen
' Else
' strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen
' End If
'Next
' strTemp = Left(strTemp, Len(strTemp) - 1) 'angepasst T.Ramel
' Print #1, strTemp
' strTemp = ""
'Next
'Close #1
'Set Bereich = Nothing
'End Sub
Public Sub prcCreateCSV(wks As Worksheet, strName As String)
Dim intFileNumber As Integer
Dim lngRow As Long
Dim vntArray As Variant
Dim intItem As Integer
Dim strText As String
Dim i As Integer
Const strSep As String = ";"
With wks.UsedRange
For lngRow = 1 To .Rows.Count
vntArray = .Cells(lngRow, 1).Resize(, .Columns.Count)
vntArray = WorksheetFunction.Transpose(vntArray)
vntArray = WorksheetFunction.Transpose(vntArray)
If strText = "" Then
strText = Join(vntArray, strSep)
Else
strText = strText _
& vbCrLf _
& IIf(lngRow = .Rows.Count, Join(vntArray, ";"), Join(vntArray, strSep))
End If
Next
End With
intFileNumber = FreeFile
Open strName For Output As #intFileNumber
Print #intFileNumber, strText
Close #intFileNumber
End Sub

danke Rene

Anzeige
das tu ich mir nicht an. owT
23.10.2012 15:31:40
Rudi

AW: das tu ich mir nicht an. owT
23.10.2012 20:23:22
rene
Sorry Rudi ,
War nicht meine Absicht !
Grüße Rene

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige