Excel VBA / Macro从.txt文件中删除不需要的逗号

时间:2017-07-12 14:08:51

标签: excel vba excel-vba

我在excel vba中编写了一段宏/一段代码,将当前的工作表发送到.txt格式的特定电子邮件中,但是当我收到该电子邮件时,文件中列出了几个不需要的逗号,我只想尝试可能会找到一段代码,当在电子邮件中发送文件时,这些代码将删除这些额外的逗号。我目前有另一个宏创建打开并读取文件并删除不需要的逗号,但我必须先保存电子邮件附件,而我想直接收到干净的.txt文件到我的电子邮件。

我收到的当前.txt文件看起来像;

S99,2602,7/12/2017,
10405,PUSH NUT PLAIN 1/4,2.000,EACH
WVC424,CORD 2.2MM E/S CHESTNUT,3.800,MTR
,,,

而我需要它看起来像;

S99,2602,7/12/2017
10405,PUSH NUT PLAIN 1/4,2.000,EACH
WVC424,CORD 2.2MM E/S CHESTNUT,3.800,MTR

将其读入我们的系统。

Sub EmailAsCSV()
'
' EmailAsCSV Macro
'
 Dim csvFiles(1 To 3) As String, i As Integer
    Dim wsName As Variant
    Dim OutApp As Object, OutMail As Object




    i = 0
    For Each wsName In Array("Sheet1")     'sheet names to be emailed - CHANGE THE SHEET NAMES
        i = i + 1
        csvFiles(i) = ThisWorkbook.Path & "\" & wsName & ".txt"
        ThisWorkbook.Worksheets(wsName).Copy
        ActiveWorkbook.SaveAs csvFiles(i), FileFormat:=xlCSV
        ActiveWorkbook.Close False
    Next


    'Email the .csv files

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ThisWorkbook.Worksheets("Sheet2").Range("E1").Value     'cell containing email address - CHANGE THE SHEET NAME AND CELL
        .CC = ""
        .BCC = ""
        .Subject = "Order"
        .Body = "This email contains 1 file attachment with an order."
        .Attachments.Add csvFiles(1)

        .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    'Delete the .csv files

    Kill csvFiles(1)

'
End Sub

Sub test()
    Dim fn As String, txt As String
    fn = Application.GetOpenFilename("TextFiles,*.txt")
    If fn = "" Then Exit Sub
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    With CreateObject("VBScript.RegExp")
        .Global = True: .MultiLine = True
        .Pattern = ",+$"
        Open Replace(fn, ".txt", "_Clean.txt") For Output As #1
            Print #1, .Replace(txt, "")
        Close #1
    End With
End Sub

上面列出了我目前获得的代码。

2 个答案:

答案 0 :(得分:0)

请尝试以文本格式保存吗?

FileFormat:=xlText

答案 1 :(得分:0)

您只能复制使用的范围(未测试):

ThisWorkbook.Worksheets(wsName).UsedRange.CurrentRegion.Copy
With Workbooks.Add
    .Sheets(1).Paste
    .SaveAs csvFiles(i), FileFormat:=xlCSV
    .Close False
End With

或粘贴值而不进行格式化(也未测试):

ThisWorkbook.Worksheets(wsName).UsedRange.Copy
With Workbooks.Add
    ActiveCell.PasteSpecial xlPasteValues
    .SaveAs csvFiles(i), FileFormat:=xlCSV
    .Close False
End With