我在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
上面列出了我目前获得的代码。
答案 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