Goeiemiddag,
Ik hoop dat jullie mij met het volgende probleem kunnen helpen. Ik ben bezig met een macro die automatisch e-mails genegeerd van een selectie die ik maak uit een draaitabel.
Hierbij maak ik per leverancier een Macrobutton met zijn naam, wanneer ik op deze button druk wordt de selectie die ik heb gemaakt in een Excel bestand naar hem gemaild.
Nu is de code momenteel nog zo, dat ik per button de Macro moet invoegen en het emailadres van de leverancier in de macro moet bouwen. Ik wil graag dat de macro het e-mailadres uit een ander tabblad haalt die in hetzelfde bestand zit. Laten we zeggen: voor leverancier X staat het e-mailadres in cel C25 op tabblad 5 (leveranciers). Hoe krijg ik mijn macro nu zo geschreven dat hij automatisch het mailadres uit de betreffende cel mailt. Hierbij alvast mijn macro.
Ik hoop dat jullie mij kunnen helpen!
Alvast bedankt!
Ik hoop dat jullie mij met het volgende probleem kunnen helpen. Ik ben bezig met een macro die automatisch e-mails genegeerd van een selectie die ik maak uit een draaitabel.
Hierbij maak ik per leverancier een Macrobutton met zijn naam, wanneer ik op deze button druk wordt de selectie die ik heb gemaakt in een Excel bestand naar hem gemaild.
Nu is de code momenteel nog zo, dat ik per button de Macro moet invoegen en het emailadres van de leverancier in de macro moet bouwen. Ik wil graag dat de macro het e-mailadres uit een ander tabblad haalt die in hetzelfde bestand zit. Laten we zeggen: voor leverancier X staat het e-mailadres in cel C25 op tabblad 5 (leveranciers). Hoe krijg ik mijn macro nu zo geschreven dat hij automatisch het mailadres uit de betreffende cel mailt. Hierbij alvast mijn macro.
Code:
Sub Leverancier1()
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & ""
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "[B]HIER WIL IK DE CELVERWIJZING DIE GEMAILD MOET WORDEN[/B]"
.CC = ""
.BCC = ""
.Subject = "Openstaande order(s) Leverancier1"
.Body = "Beste, zou u meer info kunnen verstrekken over de openstaande orders? "
.Attachments.Add Dest.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Ik hoop dat jullie mij kunnen helpen!
Alvast bedankt!
Laatst bewerkt: