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