VBS code aanpassen (Topic verplaatst)
Hallo,
Ik heb een VBscript waarmee alle emails in outlook geteld worden en geexporteerd worden naar Excel. Wij hebben veel folders in Outlook waar de hele afdeling mee werkt en verliezen het overzicht als de excel bestand geopend wordt.
1 - We willen dat er specifiek gezocht wordt binnen de hoofdfolder "Verwerkte mail" en de onderliggende subfolders.
2 - De bestandsnaam wordt opgeslagen als "OutlookCounter.xlsx". Dit willen we graag automatisch veranderd hebben naar JJJJ-MM-DD-uu:mm - [Tekst]
Wie kan mij helpen? Hieronder de Code
Alvast bedankt
SoSaid
[CPP]Dim objOutlook, objNameSpace, lItemCount, lLinePos, objExcel, myFolder
On Error Resume Next
Set objExcel= CreateObject("Excel.Application")
objExcel.visible=False
objExcel.DisplayAlerts = False
Set oWB = objExcel.Workbooks.Add
lLinePos = 1
Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
For Each myfolder In objNameSpace.Folders
EnumFolders myfolder
Next
Set objNameSpace = Nothing
Set objOutlook = Nothing
oWB.SaveAs "C:\OutlookCounter.xlsx"
objExcel.Quit
Set objExcel = Nothing
Sub EnumFolders(oFolder)
For Each oFolder In oFolder.Folders
oWB.ActiveSheet.Cells(lLinePos,1).Value=oFolder.name
oWB.ActiveSheet.Cells(lLinePos,2).Value=oFolder.Items.Count
lLinePos = lLinePos + 1
If oFolder.Folders.Count > 0 Then EnumFolders oFolder
Next
End Sub[/CPP]
Hallo,
Ik heb een VBscript waarmee alle emails in outlook geteld worden en geexporteerd worden naar Excel. Wij hebben veel folders in Outlook waar de hele afdeling mee werkt en verliezen het overzicht als de excel bestand geopend wordt.
1 - We willen dat er specifiek gezocht wordt binnen de hoofdfolder "Verwerkte mail" en de onderliggende subfolders.
2 - De bestandsnaam wordt opgeslagen als "OutlookCounter.xlsx". Dit willen we graag automatisch veranderd hebben naar JJJJ-MM-DD-uu:mm - [Tekst]
Wie kan mij helpen? Hieronder de Code
Alvast bedankt
SoSaid
[CPP]Dim objOutlook, objNameSpace, lItemCount, lLinePos, objExcel, myFolder
On Error Resume Next
Set objExcel= CreateObject("Excel.Application")
objExcel.visible=False
objExcel.DisplayAlerts = False
Set oWB = objExcel.Workbooks.Add
lLinePos = 1
Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
For Each myfolder In objNameSpace.Folders
EnumFolders myfolder
Next
Set objNameSpace = Nothing
Set objOutlook = Nothing
oWB.SaveAs "C:\OutlookCounter.xlsx"
objExcel.Quit
Set objExcel = Nothing
Sub EnumFolders(oFolder)
For Each oFolder In oFolder.Folders
oWB.ActiveSheet.Cells(lLinePos,1).Value=oFolder.name
oWB.ActiveSheet.Cells(lLinePos,2).Value=oFolder.Items.Count
lLinePos = lLinePos + 1
If oFolder.Folders.Count > 0 Then EnumFolders oFolder
Next
End Sub[/CPP]
Laatst bewerkt:
