skicka ett mail när alla celler är ifyllda

[Helenahatropu]

Hej

Jag försöker hitta ett sätt att få till ett makro så att mail till en viss adress inte skickas förrän ett antal celler är ifyllda.

 

hur gör jag detta? Jag ska försöka beskriva detta:

 

Det är fyra avdelningar som är involverade i ett excelformulär. Första avdelningen startar upp flödet, och skickar sedan när alla fält är ifyllda från deras sida.

 

Avdelning 2 och 3 får en länk när avdelning 1 har klickat på en mailknapp och de ska då gå in och fylla i ett antal fält. När de sedan är klara ska de kunna klicka på en knapp som submitar men som inte aktiverar själva mailutskicket till den sista avdelningen förrän alla celler som ligger inom avdelning 2 och 3 är ifyllda. Hur gör jag detta smartast?

 

för att ge dig en hint om hur jag gjort än så länge så ser det ut så här:

 

 

Sub sälj()

 

 

ActiveWorkbook.SaveAS "N:\SE_Shared\Affarsutveckling\Master Data\Cust Master\KUNDUPPGIFTER\" & Range("V87") & ".xls"

 

Dim OutApp As Object

Dim OutMail As Object

Dim strbody As String

 

 

If [a14].Value = "" Then

MsgBox "There MUST be an entry in Creator of template!", vbOKOnly, "Entry Reqd"

[a14].Select

Cancel = True

Exit Sub

End If

 

If [b14].Value = "" Then

MsgBox "There MUST be an entry in type of customer!", vbOKOnly, "Entry Reqd"

[b14].Select

Cancel = True

Exit Sub

End If

 

 

If ActiveWorkbook.Path <> "" Then

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

 

strbody = "<font size=""3"" face=""Calibri"">" & _

"Hej!<br><br>" & _

"Ny kunduppgift, vänligen fyll i er funktions fält och skicka vidare inom ledtid! :<br><B>" & _

ActiveWorkbook.Name & "</B> is created.<br>" & _

"klicka på länken : " & _

"<A HREF=""file://" & ActiveWorkbook.FullName & _

""">Klicka på länk</A>" & _

"<br><br>Hälsningar," & _

"<br><br>NPD ansvarig</font>"

 

On Error Resume Next

With OutMail

.To = "avdelning 2 och 3@.com"

.CC = ""

.BCC = ""

.Subject = Range("v87")

 

.HTMLBody = strbody

.Send

End With

On Error GoTo 0

 

Set OutMail = Nothing

Set OutApp = Nothing

Else

MsgBox "The ActiveWorkbook does not have a path, Save the file first."

 

 

End If

 

End Sub

 

 

Sub SaveAS()

 

ActiveWorkbook.SaveAS "N:\SE_Shared\Affarsutveckling\Master Data\Cust Master\KUNDUPPGIFTER\" & Range("V87") & ".xls"

 

Dim OutApp As Object

Dim OutMail As Object

Dim strbody As String

 

 

If [b52].Value = "" Then

MsgBox "There MUST be an entry in Name!", vbOKOnly, "Entry Reqd"

[b52].Select

Cancel = True

Exit Sub

End If

 

 

If ActiveWorkbook.Path <> "" Then

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

 

strbody = "<font size=""3"" face=""Calibri"">" & _

"Hej!<br><br>" & _

"Ny kunduppgift, vänligen fyll i er funktions fält och skicka vidare inom ledtid! :<br><B>" & _

ActiveWorkbook.Name & "</B> is created.<br>" & _

"klicka på länken : " & _

"<A HREF=""file://" & ActiveWorkbook.FullName & _

""">Klicka på länk</A>" & _

"<br><br>Hälsningar," & _

"<br><br>NPD ansvarig</font>"

 

On Error Resume Next

With OutMail

.To = avdelning 4@.com

.CC = ""

.BCC = ""

.Subject = Range("v87")

 

.HTMLBody = strbody

.Send

End With

On Error GoTo 0

 

Set OutMail = Nothing

Set OutApp = Nothing

Else

MsgBox "The ActiveWorkbook does not have a path, Save the file first."

 

 

End If

 

End Sub

Sub kredit()

 

 

ActiveWorkbook.SaveAS "N:\SE_Shared\Affarsutveckling\Master Data\Cust Master\KUNDUPPGIFTER\" & Range("V87") & ".xls"

 

Dim OutApp As Object

Dim OutMail As Object

Dim strbody As String

 

 

If [b61].Value = "" Then

MsgBox "There MUST be an entry in account clerk!", vbOKOnly, "Entry Reqd"

[b61].Select

Cancel = True

Exit Sub

End If

 

 

If ActiveWorkbook.Path <> "" Then

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

 

strbody = "<font size=""3"" face=""Calibri"">" & _

"Hej!<br><br>" & _

"Ny kunduppgift, vänligen fyll i er funktions fält och skicka vidare inom ledtid! :<br><B>" & _

ActiveWorkbook.Name & "</B> is created.<br>" & _

"klicka på länken : " & _

"<A HREF=""file://" & ActiveWorkbook.FullName & _

""">Klicka på länk</A>" & _

"<br><br>Hälsningar," & _

"<br><br>NPD ansvarig</font>"

 

On Error Resume Next

With OutMail

.To = avdelning4@.com

.CC = ""

.BCC = ""

.Subject = Range("v87")

 

.HTMLBody = strbody

.Send

End With

On Error GoTo 0

 

Set OutMail = Nothing

Set OutApp = Nothing

Else

MsgBox "The ActiveWorkbook does not have a path, Save the file first."

 

 

End If

 

End Sub

 

 

 

 

 

 

 

[Monshi]

Mitt tips är att du delar upp koden i mindre moduler. Skapa en funktion som svarar på frågan

"Är avdelning 1 klar"

och en som svarar på

"Är avdelning 2 klar"

och så vidare.

 

När avdelning ett skickar vidare filen, innan den skickar låser du förslagsvis de celler som de har fyllt i så att inte avdelning två kan ändra dessa.

 

Ja, ta det steg för steg. Dela upp allt i atomära delar, skapa en funktion för varje problem.

 

Generell kodningsprincip helt enkelt. Eller i andra ord: Skapa alla rutiner du behöver, själva skalen. Låt dem returnera fiktiva värden och utveckla sedan rutin för rutin, testa del för del.