messagerie lotus notes

bochacl

XLDnaute Nouveau
Bjr à tous,
J'ai récuppéré il y a quelques temps une macro permettant d'envoyer un classeur ou une feuille Excel à partir d'Excel via Lotus Notes, mais celle-ci me pose un problème car elle devrait ouvrir lotus et m'ouvrir mon carnet d'adresses or un bug me bloque (projet ou bibliotèque introuvable) est sur je suis en arrêt sur Left(strSento)
ci-joint le code du module :
Function Fill_LstNames()
Dim I As Integer
Dim j As Integer
Dim k As Integer
Dim strName As String
Dim Recipient() As String
Dim ccRecipient() As String
Dim strSendTo As String
Dim strCopyTo As String
Dim intCount As Integer
Dim intCount2 As Integer
Dim intPos As Integer
'Récupération des nom déjà saisis...
strSendTo = gstrSendTo
strCopyTo = gstrCopyTo
'SendTo
intPos = InStr(strSendTo, gcListSep)
I = 0
ReDim Recipient(I) As String
While intPos > 0
ReDim Preserve Recipient(I) As String
Recipient(I) = Left(strSendTo, intPos - 1)
I = I + 1
strSendTo = Mid(strSendTo, intPos + 1)
intPos = InStr(strSendTo, gcListSep)
Wend
If strSendTo <> '' Then
ReDim Preserve Recipient(I) As String
Recipient(I) = strSendTo
End If
'Copy To
intPos = InStr(strCopyTo, gcListSep)
I = 0
ReDim ccRecipient(I) As String
While intPos > 0
ReDim Preserve ccRecipient(I) As String
ccRecipient(I) = Left(strCopyTo, intPos - 1)
I = I + 1
strCopyTo = Mid(strCopyTo, intPos + 1)
intPos = InStr(strCopyTo, gcListSep)
Wend
If strCopyTo <> '' Then
ReDim Preserve ccRecipient(I) As String
ccRecipient(I) = strCopyTo
End If
'Chargement des éléments de la liste de correspondants
With ThisWorkbook.Sheets('AddressBook')
I = 1
k = 0
intCount = UBound(Recipient)
intCount2 = UBound(ccRecipient)
'Tant qu'il y a une valeur dans la colonne A
Do While .Range('A1').Offset(I) <> ''
'Ajout de cette valeur dans la liste de correspondant
strName = .Range('A1').Offset(I)
'On regarde si le nom n'est pas déjà dans la liste des destinataires
For j = 0 To intCount
If strName = Recipient(j) Then
FrmAddress.LstTo.AddItem strName
strName = ''
Exit For
End If
Next j
If strName <> '' Then
'On regarde si le nom n'est pas déjà dans la liste CC
For j = 0 To intCount2
If strName = ccRecipient(j) Then
FrmAddress.LstCC.AddItem strName
strName = ''
Exit For
End If
Next j
If strName <> '' Then
FrmAddress.LstNames.AddItem strName
ReDim Preserve Members(k) As String
Members(k) = strName
k = k + 1
End If
End If
I = I + 1
Loop
End With
'Appel de la fonction SetStatusButton
Call SetStatusButton
End Function
:sick: Merci de vos réponses et surtout de vos lumières
 

Discussions similaires

Réponses
2
Affichages
273

Statistiques des forums

Discussions
312 342
Messages
2 087 433
Membres
103 545
dernier inscrit
agent3