Я помогаю своей команде на работе изменить файл, который используется для отправки оставшихся командных праздников менеджерам. Макрос сделан не мной, я просто немного его модифицировал, но я не очень опытен. Проблема в том, что для большинства моих коллег файлы работают, но только для одного коллеги, когда она нажимает кнопку макроса, всплывающие сообщения электронной почты, вложение есть, но оно пустое !! Я правда не знаю в чем может быть проблема, у нее как установлены обновления, та же версия excel, что и у меня, патч в C: \ создал ..
Sub send_holidays_to_managers()
Dim subject, fileN As String
'-------------------------------------------------------------------------------------------
'------------------------------ SET VARIABLES ---------------------------------------------
'-------------------------------------------------------------------------------------------
' (output mail, subject)
Debug.Print Range("month2").Value
Debug.Print Range("year").Value
subject = "Holidays report" & " - " & Range("month2").Value & " " & Range("year").Value
' (output mail, body)
Const warningMessage As String = "***********************************************************************************************" & vbCrLf & "This message and any attachments are confidential and intended for the named addressee(s) only." & vbCrLf & "If you have received this message in error, please notify immediately the sender, then delete the message. Any unauthorized modification, edition, use or dissemination is prohibited." & vbCrLf & "The sender shall not be liable for this message if it has been modified, altered, falsified, infected by a virus or even edited or disseminated without authorization." & vbCrLf & "***********************************************************************************************"
Dim messageFinal As String
messageFinal = "Hello," & vbCrLf & vbCrLf & _
"Please find attached the Holidays report of your Team Members." & vbCrLf & vbCrLf & _
"Best regards,"
' Temporary XLSX file, sent to each manager
' THE PATH MUST EXIST !!!
fileN = "C:\tmp\Team_holidays_report_" & Range("E1").Value & " " & Range("year").Value & ".xlsx"
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------
Dim line, lineS2, lineWBTemp As Integer
Dim sheetHolidays, sheetMails, BU, lastBU, emailManager, wbPattern, wbTemp, current_BU As String
Dim OutApp, OutMail, NewBook As Object
Dim BU_list As Excel.Range
sheetHolidays = "Summary"
sheetMails = "Mails"
wbPattern = ThisWorkbook.Name
Set OutApp = CreateObject("Outlook.Application")
' DATA UPDATE
' Remove old data
Sheets("Summary").ListObjects("Recap").Range.AutoFilter Field:=2
If Not (Sheets(sheetHolidays).ListObjects("Recap").DataBodyRange Is Nothing) Then
Sheets(sheetHolidays).ListObjects("Recap").DataBodyRange.Rows.Delete
End If
' Update connections
'ActiveWorkbook.RefreshAll
' Copy paste the new one
Range("HOLIDAYS[ID]").Copy
Sheets("Summary").Select
Range("Recap[ID]").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Create directory 'C:\tmp'
If Not (directoryExists("C:\tmp")) Then
MkDir ("C:\tmp")
End If
' OUTPUT WORKBOOK
Application.DisplayAlerts = False
Set NewBook = Workbooks.Add
With NewBook
.Title = "holidays_report"
.SaveAs Filename:=fileN
End With
wbTemp = NewBook.Name
' Set the first line here
line = 8
lineWBTemp = 8
Workbooks(wbPattern).Activate
'Application.Goto Workbooks(wbPattern).Sheets(sheetHolidays).Range("A1")
'Sheets("Mails").Select
Set BU_list = Range("Mails[BU]")
For Each c In BU_list.SpecialCells(xlCellTypeVisible)
current_BU = c
emailManager = managerMail(current_BU)
' Filter with the BU
Sheets("Summary").Select
Application.GoTo Workbooks(wbPattern).Sheets(sheetHolidays).Range("A1")
ActiveSheet.ListObjects("Recap").Range.AutoFilter Field:=2, Criteria1:=current_BU
'Manager does not exist
If emailManager = "" Then
MsgBox "The manager's trigram " & current_BU & " does not exist in the list, " & sheetMails
Else ' Manager exists
On Error Resume Next
Set OutMail = OutApp.CreateItem(0)
Workbooks.Open fileN
Set NewBook = Workbooks(wbTemp)
' Clear old sheet
Application.GoTo Workbooks(wbTemp).Sheets("Sheet1").Activate
If Selection.Count <= 1 Then
Columns("A:W").Select
End If
Selection.Clear
' Copy
Application.GoTo Workbooks(wbPattern).Sheets(sheetHolidays).Activate
ActiveSheet.Range(Range("B1:W6"), Range("Recap[#All]")).Select
Selection.Copy
' Paste
Application.GoTo Workbooks(wbTemp).Sheets("Sheet1").Activate
ActiveSheet.Range("A1").Select
ActiveSheet.Paste
Range("C1").Select
' Avoid formulas (not possible before)
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Columns Width
Columns("A:X").EntireColumn.AutoFit
' Remove the buttons
ActiveSheet.Shapes.Range(Array("Green_button")).Delete
ActiveSheet.Shapes.Range(Array("Orange_button")).Delete
' Save and Close
NewBook.Save
NewBook.Close
' Prepare and send email
If debugg = True Then
With OutMail
.To = mailDebug
.CC = ""
.BCC = ""
.subject = subject
.Body = "This mail should have been sent to : " & emailManager & vbCrLf & vbCrLf & messageFinal & vbCrLf & warningMessage
.Attachments.Add fileN
'.Send
.Display
End With
Else
With OutMail
.To = emailManager
.CC = ""
.BCC = ""
.subject = subject
.Body = messageFinal & vbCrLf & warningMessage
.Attachments.Add fileN
'.Send
.Display
End With
End If
Set OutMail = Nothing
On Error GoTo 0
End If
Next c
Set OutApp = Nothing
End Sub