1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
| Sub RenseignerContacts()
Dim olApp As Outlook.Application
Dim dossierContacts As Outlook.MAPIFolder
Dim Contact As Outlook.ContactItem
Dim i As Integer, j As Integer, k As Integer, l As Integer, v As Integer
Dim a As Integer
Dim finput As FileDialog
Dim CheminDestination As String
Set finput = Application.FileDialog(msoFileDialogFilePicker)
MsgBox "Veuillez indiquer l'emplacement du CCTP."
finput.Show
Sheets("Feuil2").Cells(2, 7).Value = CStr(finput.SelectedItems(1))
For v = 13 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(v, 1).Value = "-" Then
Rows(v).Select
Selection.Delete Shift:=xlUp
End If
Next v
Dim ListeContacts(15, 15) As String
Set olApp = New Outlook.Application
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
'Verifie si le dossier des contacts contient des éléments
If dossierContacts.Items.Count = 0 Then Exit Sub
For i = 13 To 200
If Cells(i, 1).Value = "" Then Exit For
If Cells(i, 5).Value <> "" Then
Else
If Cells(i, 1).Value <> "-" Then
Erase ListeContacts
k = 0
For Each Contact In dossierContacts.Items
If Cells(i, 4) = Contact.CompanyName Then
ListeContacts(k, 0) = Contact.FullName
ListeContacts(k, 1) = Contact.BusinessTelephoneNumber
ListeContacts(k, 2) = Contact.MobileTelephoneNumber
ListeContacts(k, 3) = Contact.Email1Address
k = k + 1
End If
Next Contact
j = i
For l = 0 To k - 1
If l = 0 Then
Cells(j, 5).Value = ListeContacts(l, 0)
Cells(j, 7).Value = ListeContacts(l, 1)
Cells(j, 8).Value = ListeContacts(l, 2)
Cells(j, 6).Value = ListeContacts(l, 3)
Else
j = j + 1
Rows(i).Select
Selection.Copy
Rows(j).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Cells(j, 5).Value = ListeContacts(l, 0)
Cells(j, 7).Value = ListeContacts(l, 1)
Cells(j, 8).Value = ListeContacts(l, 2)
Cells(j, 6).Value = ListeContacts(l, 3)
Cells(j, 1).Value = "-"
Cells(j, 2).Value = "-"
Cells(j, 3).Value = "-"
End If
Next l
End If
End If
If Sheets("Fournisseurs").Cells(i, 9).Value = "" Then
Dim Corps As String
Corps = "Bonjour," 'début du message
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & "Je vous contacte concernant le projet repris en objet. Pouvez-vous me chiffrer les équipements ou prestations décrit(e)s dans le CCTP ci-joint (voir pages ci-dessous) ?"
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & Sheets("Fournisseurs").Cells(i, 2).Value
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
If Sheets("Fournisseurs").Cells(i, 12).Value <> "" Then
Corps = Corps & Sheets("Fournisseurs").Cells(i, 12).Value
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
End If
Corps = Corps & "Merci d'avance,"
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & "Cordialement."
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & "Alexis Nicotera - Ingénieur Etudes Projets - Santerne Fluides"
Corps = Corps & Chr(13) & Chr(10) 'passage à la ligne
Corps = Corps & "Mobile : 07 63 87 53 47"
If Sheets("Fournisseurs").Cells(i, 13).Value = "" And Sheets("Fournisseurs").Cells(i, 14).Value = "" And Sheets("Fournisseurs").Cells(i, 15).Value = "" Then
Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(i, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value)
End If
If Sheets("Fournisseurs").Cells(i, 13).Value <> "" And Sheets("Fournisseurs").Cells(i, 14).Value = "" And Sheets("Fournisseurs").Cells(i, 15).Value = "" Then
Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(i, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value, Sheets("Fournisseurs").Cells(i, 13).Value)
End If
If Sheets("Fournisseurs").Cells(i, 13).Value <> "" And Sheets("Fournisseurs").Cells(i, 14).Value <> "" And Sheets("Fournisseurs").Cells(i, 15).Value = "" Then
Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(i, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value, Sheets("Fournisseurs").Cells(i, 13).Value, Sheets("Fournisseurs").Cells(i, 14).Value)
End If
If Sheets("Fournisseurs").Cells(i, 13).Value <> "" And Sheets("Fournisseurs").Cells(i, 14).Value <> "" And Sheets("Fournisseurs").Cells(i, 15).Value <> "" Then
Call EnvoyerEmail(Sheets("Fournisseurs").Range("B4").Value & " - " & Sheets("Fournisseurs").Cells(i, 1).Value, Sheets("Fournisseurs").Cells(13, 6).Value, Corps, Sheets("Feuil2").Range("G2").Value, Sheets("Fournisseurs").Cells(i, 13).Value, Sheets("Fournisseurs").Cells(i, 14).Value, Sheets("Fournisseurs").Cells(i, 15).Value)
End If
Sheets("Fournisseurs").Cells(i, 9).Value = Date
End If
Next i
Dim Repertoire As FileDialog
MsgBox "Veuillez indiquer l'emplacement du dossier Consultations ?"
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
If Repertoire.SelectedItems.Count > 0 Then _
CheminDestination = Repertoire.SelectedItems(1)
For i = 13 To Sheets("Fournisseurs").Range("A" & Rows.Count).End(xlUp).Row
If Sheets("Fournisseurs").Cells(i, 4).Value <> "" And Sheets("Fournisseurs").Cells(i, 9).Value Then
MkDir (CStr(CheminDestination) & "/" & Sheets("Fournisseurs").Cells(i, 4).Value & "/")
End If
Next i
MsgBox "Consultations envoyées!"
End Sub |
Partager