Share via

I need help with excel VBA code

Anonymous
2023-01-26T13:43:48+00:00

I have not created this code, is rather copying different codes and putting it together.

I need to send via email a full sheet,including the design, and the dropdown list, the code I have now it works, but it sends the sheet raw, meaning only the information, no design or the drop down list. This is my code, can someone help me what I should change in order to have the full sheet:
Sub Mailtrail()

Application.DisplayAlerts = False  
Application.ScreenUpdating = False  
  
Mail  
  
Application.DisplayAlerts = True  
Application.ScreenUpdating = True  

End Sub

Sub Mail()
Dim Today As String
Dim Row As Integer
Dim DSP As String
Dim Too As String
Dim PMAM As String
Dim i As Integer
Dim wb As Workbook
Dim outlookapp As Variant
Dim OutlookMailItem As Variant
Dim myAttachments As Variant
Dim Temp As String
Dim FileAttachement As String
Dim CountZBF As Integer

CountZBF = Sheets("ZBF1").Cells(Rows.Count, 2).End(xlUp).Row  
  
Temp = GetTempFolder  
PMAM = Sheets("Info").Cells(5, 2).Value  
Today = Sheets("Info").Cells(1, 2).Text  
FileAttachement = Temp & PMAM & " Zustellerbefragung " & Today & " " & DSP & ".xlsx"  

Row = Worksheets("Info").Cells(Rows.Count, 8).End(xlUp).Row  
  
For i = 1 To Row  
  
    DSP = Sheets("Info").Cells(i, 8).Value  
    Too = Sheets("Info").Cells(i, 9).Value  

    Sheets("ZBF1").Select  
    Rows("1:1").Select  
    Selection.AutoFilter  
    ActiveSheet.Range("$A$1:$AM$" & CountZBF).AutoFilter Field:=2, Criteria1:="\*" & DSP & "\*"  
    Cells.Select  
    Selection.Copy  
    Set wb = Workbooks.Add  
    Range("A1").PasteSpecial xlPasteValues  
   wb.SaveAs FileAttachement, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges  
   wb.Close  
    Set outlookapp = CreateObject("outlook.application")  
    Set OutlookMailItem = outlookapp.CreateItem(0)  
    Set myAttachments = OutlookMailItem.Attachments  
      
    With OutlookMailItem  
    .To = Too  
    .CC = Sheets("Info").Cells(4, 14).Text  
    .Subject = PMAM & " Zustellerbefragung für " & DSP & " " & Today  
    .Body = "Hallo DSP" & Chr(13) & Chr(13) & "Im Anhang findet ihr eure Zustellerbefragung." & Chr(13) & Chr(13) & "Bitte sendet diese innerhalb von 6 h an ******@amazon.com" & Chr(13) & Chr(13) & "Viele Grüße" & Chr(13) & Chr(13) & "ORM-Team"  
    .Attachments.Add FileAttachement  
    .Send  
    End With  
    Kill (FileAttachement)  
Next i  
Sheets("ZBF1").Select  
Rows("1:1").Select  
Selection.AutoFilter  

End Sub

Function GetTempFolder()

GetTempFolder = Environ("temp") & "\"  
  

End Function

Microsoft 365 and Office | Excel | For business | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments No comments

1 answer

Sort by: Most helpful
  1. Anonymous
    2023-01-26T13:57:29+00:00

    Hi Fjoralba,

    Greetings! Thank you for posting to Microsoft Community.

    Some feature will not work in mail. You can copy the sheet to a new workbook and sent the workbook to your recipient.

    Best Regards,

    Snow Lu

    Was this answer helpful?

    0 comments No comments