Question

正如标题所述。我试图自动化这个过程。最终结果是，我将文本文件通过电子邮件发送给静态收件人。如果可以包括那么好，如果没有，我有另一个宏来处理这个简单的任务。

我可以将我想要的选择（AM1：CK74）复制到新的工作簿中，但其余部分超出我的范围。

所以，我想从命令按钮做的是将AM1：CK74从活动工作表复制到新工作簿，将A1粘贴为值和数字格式，另存为制表符分隔.txt，文件名应该是细胞B1和C1的值。然后用Outlook发送此文本文件。

非常感谢任何帮助。我已经搞乱了自动记录功能，但这对我来说太具体了。

    Sub DataPull3()
'
' DataPull3 Macro
'

'
    Range("AL1:CK74").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs FileName:="C:\Users\##\Documents\Book10.txt", _
        FileFormat:=xlText, CreateBackup:=False
End Sub

谢谢。

Answer 1

希望这会有所帮助..

Sub Macro2()

     Dim OutApp As Object
    Dim OutMail As Object

    Range("AM1:CK74").Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "C:\temp"
    ActiveWorkbook.SaveAs Filename:="C:\temp\Book3.txt", FileFormat:=xlText, CreateBackup:=False

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

    On Error Resume Next
    With OutMail
        .to = "email.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
  '      .Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add ("C:\temp\Book3.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Answer 2

通过你的慷慨援助，我解决了我的问题。有关我所做的更改，请参阅附带的代码。

谢谢！

Sub CopyDistribute()

     Dim OutApp As Object
    Dim OutMail As Object
    Dim relativePath As String, sname As String

    Application.ScreenUpdating = False

    Range("AM1:CK74").Copy
    Workbooks.Add
     Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

        Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:=relativePath & Range("A1") & Range("B1"), _
    FileFormat:=xlText, CreateBackup:=False

    sname = ActiveWorkbook.Worksheets(1).Range("A1") & ".xls"
    relativePath = Application.ActiveWorkbook.path & "\" & sname
        Application.DisplayAlerts = True


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

    On Error Resume Next
    With OutMail
        .to = "EMAIL.com"
        .cc = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add ActiveWorkbook.FullName
        .Send
    End With
    ActiveWorkbook.Close False

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

将选择从工作表复制到新工作簿，值/数字格式，另存为制表符分隔.txt到特定位置，关闭新工作簿

2 个答案: