Ahoj,
Pokouším se odeslat e-mail na základě nepřímé změny hodnoty buňky (např. > 7), s přílohou e-mailu a konkrétním odkazem na změněné buňky v těle mé odchozí pošty. Mám nepřímou změnu hodnoty buňky na základě kritérií. Při pokusu o nastavení proměnné pro volání adresy buňky do mého e-mailu se mi však zobrazuje chyba 424. Mohl byste pomoci? Cítím, že jsem blízko.
Dim xRg jako rozsah
Dim xRgSel jako rozsah
'Nastavit rozsah a cíl
Soukromá dílčí tabulka_Změna (ByVal Target As Range)
Dim xRgPre As Range
On Error Resume Next
Pokud Target.Cells.Count > 1, pak Exit Sub
Nastavit xRg = rozsah("Q2:Q43")
Nastavte xRgPre = xRg.Precedenty
Nastavit xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
Pokud xRg.Value > 7 Pak
Zavolejte Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
End If
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp jako objekt
Dim xOutMail jako objekt
Dim xMailBody jako řetězec
Set xOutApp = CreateObject("Outlook.Application")
Nastavit xOutMail = xOutApp.CreateItem(0)
xMailBody = "Dobrý den, buňky" & xRgSel.Address(False, False) & _
" v pracovním listu '" & Me.Name & "' jsou 3 dny po příjmu" & vbNewLine & vbNewLine & _
"Prosím, zkontrolujte a oslovte potenciálního zákazníka" & vbNewLine & _
"Děkuji"
On Error Resume Next
S xOutMail
.To = "rdavis@bridge.partners"
.CC = ""
.BCC = ""
.Subject = "Dny od příjmu olova"
.Tělo = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display 'nebo .Send
Konec s
Při chybě GoTo 0
Nastavte xOutMail = nic
Nastavte xOutApp = Nic
End Sub
Díky!
Pokouším se odeslat e-mail na základě nepřímé změny hodnoty buňky (např. > 7), s přílohou e-mailu a konkrétním odkazem na změněné buňky v těle mé odchozí pošty. Mám nepřímou změnu hodnoty buňky na základě kritérií. Při pokusu o nastavení proměnné pro volání adresy buňky do mého e-mailu se mi však zobrazuje chyba 424. Mohl byste pomoci? Cítím, že jsem blízko.
Dim xRg jako rozsah
Dim xRgSel jako rozsah
'Nastavit rozsah a cíl
Soukromá dílčí tabulka_Změna (ByVal Target As Range)
Dim xRgPre As Range
On Error Resume Next
Pokud Target.Cells.Count > 1, pak Exit Sub
Nastavit xRg = rozsah("Q2:Q43")
Nastavte xRgPre = xRg.Precedenty
Nastavit xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
Pokud xRg.Value > 7 Pak
Zavolejte Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
End If
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp jako objekt
Dim xOutMail jako objekt
Dim xMailBody jako řetězec
Set xOutApp = CreateObject("Outlook.Application")
Nastavit xOutMail = xOutApp.CreateItem(0)
xMailBody = "Dobrý den, buňky" & xRgSel.Address(False, False) & _
" v pracovním listu '" & Me.Name & "' jsou 3 dny po příjmu" & vbNewLine & vbNewLine & _
"Prosím, zkontrolujte a oslovte potenciálního zákazníka" & vbNewLine & _
"Děkuji"
On Error Resume Next
S xOutMail
.To = "rdavis@bridge.partners"
.CC = ""
.BCC = ""
.Subject = "Dny od příjmu olova"
.Tělo = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display 'nebo .Send
Konec s
Při chybě GoTo 0
Nastavte xOutMail = nic
Nastavte xOutApp = Nic
End Sub
Díky!