Dansk Regneark Forum
  Hjælp Hjælp  Søg i forum   Arrangementer   Opret ny bruger Opret ny bruger  Log ind Log ind


Emne lukketSende mail, hvis cell value = Yes

 Besvar Besvar
Forfatter
Hartig Se dropdown
Bronze bruger
Bronze bruger
Avatar

Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
Direkte link til dette indlæg Emne: Sende mail, hvis cell value = Yes
    Sendt: 24.Mar.2022 kl. 14:51
Jeg har et ark med ret meget kode i, men nu kunne jeg godt tænke mig, OGSÅ at få det til at sende en mail med PDF-filen vedhæftet til kunden, hvis kunden selv ønsker dette i forbindelse med eftersynet (Dvs. E7 bliver til "Yes")


Til top



Til top
Hartig Se dropdown
Bronze bruger
Bronze bruger
Avatar

Medlem: 14.Dec.2018
Land: Danmark
Status: Offline
Point: 42
Direkte link til dette indlæg Sendt: 24.Mar.2022 kl. 14:52
Private Sub GemSomPDF_Click()

    Dim rngCheck As Range
    Dim cllCheck As Range
    Dim bRedCell As Boolean
    Dim bCheckX As Boolean
    
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    Dim sht As Worksheet
    Set sht = ActiveSheet
    
    If Len(Dir("c:\1_Completed_PM", vbDirectory)) = 0 Then
       MkDir "c:\1_Completed_PM"
    End If
    
    'Set path to Folder
    fPath = "c:\1_Completed_PM\"
    
    'Build File Name from Sheet1 A3, A4 & C4
    With sht
    
    fName = .Range("A3") & "-" & _
            .Range("A4") & "-" & _
            .Range("C4")
    fName = Replace(fName, "/", "_", , , vbTextCompare)
            
    End With

    'Export as PDF to Folder
    Set rngCheck = sht.Range("A1:E200")
   
    For Each cllCheck In rngCheck.Cells
   
        If cllCheck.DisplayFormat.Interior.Color = 8696052 Then
             
            MsgBox "There are still red cells in the PM checklist", vbOKOnly + vbCritical, "Cell-check"
           
            bRedCell = True
           
            Exit For
       
        End If
   
    Next cllCheck
   
    If Not bRedCell Then
    Application.PrintCommunication = False
     With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        '.Orientation = xlLandscape
        .Orientation = xlPortrait
        .PaperSize = ePaperSize
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 0
    End With
    
        sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
            
            If Err = 0 Then
                       
                MsgBox "The PM checklist are now saved with success. It can be found in the folder= C:\1_Completed_PM\ to attach Work Order in IFS.", vbInformation
                               
                 Set rngCheck = sht.Range("D9:D200")
                
                 For Each cllCheck In rngCheck.Cells
                
                     If UCase(cllCheck) = "X" Then
                    
                         bCheckX = True
                        
                         Exit For
                    
                     End If
                
                 Next cllCheck
    
                If bCheckX Then
                
                    If MsgBox("According to PM WO " & sht.Range("A3") & ", is one ore more things in " & sht.Range("A4") & " Not OK" & vbNewLine & vbNewLine & _
                              "Do you wish to send an e-mail to customerservice, so they can create a new Work Order? (INFO: The mail will be send, when the computer has internet, and Outlook is open)", _
                              vbYesNo + vbQuestion, "Send e-mail to get new Work Order?") = vbYes Then
                    
                        With OutMail
                            
                            .To = Sheets("Customer service e-mail address").Range("G1")
                                
                            .Attachments.Add fPath & fName & ".pdf"
                            
                            .CC = ""
                            .BCC = ""
                            
                            .Subject = "According to PM WO number " & sht.Range("A3") & ", a new Work Orders is needed in " & sht.Range("A4") & " IFS-number: " & sht.Range("A2") & ""
                            
                            .display
                            
                            .HTMLbody = "<HTML><BODY>" & _
                            "<span style=""color:#FF0000"">On the Preventive Maintenance is one ore more things <u>''NOT OK''</u></span style=""color:#FF0000"">" & _
                            "<br>" & _
                            "<span style=""color:#FF0000"">A new Work Order needs to be created to fix this</span style=""color:#FF0000"">" & _
                            "<br><br>" & _
                            "(Make X's below if it's urgent, and if it should be invoiced. Insert the name of the contact/reference)" & _
                            "<br><br>" & _
                            "<b>Urgent (Priority 1) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <u>_______________________</u></b>   " & _
                            "<br>" & _
                            "<b>Regular service (Priority 2) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <u>_______________________</u></b> " & _
                            "<br>" & _
                            "<b>By occasion (Priority 3) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<u>_______________________</u></b> " & _
                            "<br><br>" & _
                            "<b>Being fixed on this PM? &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; YES<u>______</u> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NO<u>______</u></b> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span style=""color:#FF0000"">If YES - a Work Order should be created to <u>" & sht.Range("C3") & "</u> ASAP</span style=""color:#FF0000"">" & _
                            "<br><br>" & _
                            "<b>Should this be invoiced? &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; YES<u>______</u> &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NO<u>______</u></b> " & _
                            "<br><br>" & _
                            "<b>Contact in store: &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <u>_______________________</u></b>" & _
                            "<br><br>" & _
                            "<b>Description of what NOT OK in the store:&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<u> " & sht.Range("A36") & "</b></u>" & _
                            "<br><br>" & _
                            "</BODY></HTML>" & _
                            "<br><br>" & _
                            OutMail.HTMLbody
                        
                        End With
                        
                    End If
                
                End If
                
            End If
       
    Else
   
        MsgBox "PDF-file NOT SAVED because of red cells", vbOKOnly + vbCritical, "PDF-file NOT SAVED"
   
    End If

End Sub
Til top
 Besvar Besvar

Skift forum Forum tilladelser Se dropdown

© 2010 - 2024 Dansk Regneark Forum - en del af Excel-regneark.dk