XL 2016 Methode Wait

scorpion4

XLDnaute Nouveau
Bonjour le Forum,

je suis un nouveau dans Excel VBA donc je ne metrise vraiment pas comment coder. En fait je travaille sur un code qui me permet d' impoter certains e-mail du Outlook vers excel . Mais pour que le code s execute il que je lance la Macro deux fois .j aimerai savoir si quelqu un pourrai me donner une bonne syntax de la methode Wait .celles que j ai pu avoir sur le Net ne marche pas. Et aussi a t on besoin d ajouter une Bibliotheque lors de l utilisation de celle ci? Merci d avance pour vos reponses
 

scorpion4

XLDnaute Nouveau
Public Function Excel_Ouvert() As Boolean

Dim Wb As Excel.Workbook
Dim Appli As Excel.Application
Dim xlApp As Excel.Application
Dim ExcelWkBk As Excel.Workbook

On Error Resume Next

'Set Appli = GetObject(, "Excel.Application")

Set xlApp = Application.CreateObject("Excel.Application")
With xlApp
.Visible = True ' This slows your macro but helps during debugging
Set ExcelWkBk = xlApp.Workbooks.Open("C:\Users\sug7fe\Desktop\test.xls")

End With

If xlApp Is Nothing Then
Excel_Ouvert = False
Else
Excel_Ouvert = True
End If

For Each Wb In Appli.Workbooks
If Wb.Name = "test.xls" Then
'MsgBox "Le classeur est ouvert"
Wb.Close True ' Fermeture classeur en sauvegardant les modifications
Exit Function
End If
Next Wb

End Function





Sub getdatafromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim FolderImpMail As Outlook.Folder
Dim outlookMail As Variant
Dim Item As Outlook.MailItem
Dim myfolder As MAPIFolder
Dim i As Integer
Dim AnzahlMail As Integer
Dim xlApp As Excel.Application
Dim ExcelWkBk As Excel.Workbook



Set OutlookApp = CreateObject("Outlook.application")

Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("ImpMail")
'Set myfolder = Application.Workbook.Open("C:\Users\sug7fe\Desktop\DatafromOutlook.xlsm")





If Excel_Ouvert = False Then

MsgBox "Le classeur est ferme"
End If



Application.Wait (Now + TimeValue("0:00:50"))


If Folder.Items > 0 Then

i = 3

For Each outlookMail In Folder.Items

Cells(i, 1).Value = outlookMail.ReceivedTime 'Datum einfügen
Cells(i, 1).NumberFormat = "dd.mm.yy"
Cells(i, 2).Value = outlookMail.Subject 'Betreff einfügen
Cells(i, 2).Columns.AutoFit
Cells(i, 2) = Replace(Cells(i, 2), "WG: Expired EhP - ", "") 'unwichtige entfernen
Cells(i, 3).Value = outlookMail.Body 'Text einfügen

i = i + 1


Next outlookMail

End If

'ID vom text extrahieren und Excel aufräumen

Dim derligne%, x2, x3, ta
On Error Resume Next
derligne = Cells(Rows.Count, 2).End(3).Row
ReDim ta(1 To 1000, 1 To 1)

For i = 2 To derligne
Cells(i, 4) = "": x3 = ""
x2 = Split(Cells(i, 3), "ID: ")
x3 = Left(x2(1), 4)
Cells(i, 3) = x3
'ta(i - 1, 1) = x3

Next i

'emails in anderen ordner importieren

AnzahlMail = Folder.Items.Count
Set myfolder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("ImpMail").Folders("erledigte Mails")

Do While AnzahlMail > 0
Folder.Items(1).Move myfolder

AnzahlMail = AnzahlMail - 1
Loop


'Objectvariablen leeren
Set Item = Nothing
Set FolderImpMail = Nothing
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub




voici le code en question lorsque je le lance pour la premiere fois il ya une erreur au niveau de " Cells(i, 1).Value = outlookMail.ReceivedTime 'Datum einfügen " mais lorsque je relance pour une 2 eme fois tout fonctionne .je me suis donc dit qu il faut que je mette une pause le temps pour excel de s ouvrir a fin que les infos puisses etre importer
 

Staple1600

XLDnaute Barbatruc
Re

Pour interagir avec Outlook depuis Excel, j'utilise souvent ce genre de syntaxe VBA
Regardes et testes ce petit exemple ci-dessous
(Code à mettre dans un module standard)
VB:
Sub testOL2XL()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder
Call ProcessFolder(olFolder)
'==> ajout pour mise en forme <==
With Cells(1).CurrentRegion
    .Columns.AutoFit
    .Borders.Weight = 2
End With
'==> fin ajout <==
Set olFolder = Nothing
Set olApp = Nothing
Set olNS = Nothing
End Sub

Sub ProcessFolder(olfdStart As Outlook.MAPIFolder)
Dim olObject As Object, n As Long
Cells(1).Resize(, 3) = Array("Objet MAIL", "Date Réception", "Nom Emetteur")
n = 2
For Each olObject In olfdStart.Items
If TypeName(olObject) = "MailItem" Then
Cells(n, 1).Value = olObject.Subject
Cells(n, 2).Value = olObject.ReceivedTime
Cells(n, 3).Value = olObject.SenderName
n = n + 1
End If
Next
Set olObject = Nothing
End Sub
Pour tester:
1) laisse Outlook ouvert (en réduction dans la barre des tâches)
2) lance la macro testOL2XL, choisis alors le dossier dans Outlook
3) observe le résultat dans la feuille active.

PS: Test OK sur mon PC.
 

scorpion4

XLDnaute Nouveau
Re

Tu as mis le code VBA où?
La référence est bien cochée?
Quand tu lances la macro, tu dois une boite dee dialogue qui s'affiche et qui te demande de sélectionner un dossier dans Outlook, est-ce le cas chez toi?








J ai mis le code dans un modul , je reçois la boîte de dialogue le dossier aussi je l ai choisis. Excel s ouvre mais il ya rien à l intérieur . Je crois que je vais devenir fou
 

Discussions similaires

Statistiques des forums

Discussions
314 647
Messages
2 111 533
Membres
111 197
dernier inscrit
john49