当控件从一个子传递到另一个子时,如何处理相同的工作簿?

时间:2017-11-02 11:43:54

标签: excel excel-vba vba

我正在创建一个宏来接收我的originfileSaveAsCopy tempfile,从tempfile删除一些工作表和一些列,最后通过Outlook邮件发送tempfile

我的代码编译并运行。它不太好用。它没有做任何修改:因此缺少新生成的临时文件中的删除内容。

这是我的代码:

Macro Master

Sub run_all()
    Call files_mang
    Call delete
    Call mailing_tempfile
End Sub
Sub files_mang() 
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010,
'  Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OrigFileName As String
    Dim FileExtStr As String

TempFilePath = "filepathhere"
FileExtStr = ".xlsx"
OrigFileName = TempFilePath & "Suivi interne déploiements OINIS S40" & FileExtStr
TempFileName = "Suivi déploiements OINIS - NOKIA S40" & FileExtStr

Set wb1 = Workbooks.Open(OrigFileName)
Set wb1 = ActiveWorkbook

If Val(Application.Version) >= 12 Then
    If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
     MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
      "be no VBA code in the file you send. Save the" & vbNewLine & _
      "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
       Exit Sub
    End If
End If

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

' Make a copy of the file.
' If you want to change the file name then change only TempFileName variable.

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
Set wb2 = ActiveWorkbook

End Sub
Sub delete()

    Application.DisplayAlerts = False

    'Delete columns like intern com ect ...
    With Worksheets("Suivi Projet WELDON")
    .Columns("R:X").delete
    End With

    With Worksheets("Suivi projet Highway")
    .Columns("T:Z").delete
    End With

    'Delete non usful sheets for client
    Worksheets("SuiviCarteOrange").delete
    Worksheets("Cartes Orange En Panne").delete

    Application.DisplayAlerts = True

End Sub
Sub mailing_tempfile()
Dim OutApp As Object
Dim OutMail As Object

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

On Error Resume Next
' Change the mail address and subject in the macro before you run this procedure.

With OutMail
    .To = "emailaddresshere"
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .Body = "Hello World!"
    .Attachments.Add ActiveWorkbook.FullName
    ' You can add other files by uncommenting the following line.
    '.Attachments.Add ("C:\test.txt")
    ' In place of the following statement, you can use ".Display" to
    ' display the mail.
    .Send
End With
On Error GoTo 0

ActiveWorkbook.Close SaveChanges:=False

' Delete the file.
'Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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

0 个答案:

没有答案