Solved: Counting no always higher ... even in between sessions

[Charlize]

I use this little thing to print attachments in a specified folder and for a specified format (doc). The problem is that I need a way to store i and when I use this macro again, i = value of last session. Anyone has an idea ? Thanks in advance.Sub SaveAttachments()
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim avDate() As String
Dim vDate As String
Dim i As Long

Const myPath As String = "C:\Data\Bijlagen\"
ReDim Preserve avDate(3)

Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myFolder = myFolder.Folders("Facturen")
For Each myItem In myFolder.Items
If myItem.UnRead = True Then
avDate = Split(CStr(myItem.ReceivedTime), "/")
vDate = Mid(avDate(2), 1, 4) & "-" & avDate(1) & "-" & avDate(0)
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
i = i + 1
myAttachment.SaveAsFile (myPath & vDate & " - " & i & " - " & _
myAttachment.FileName)
If UCase(Right(myAttachment.FileName, 3)) = "DOC" Then
Printatt (myPath & vDate & " - " & i & " - " & myAttachment.FileName)
End If
Next
myItem.UnRead = False
End If
End If
Next
End Sub
Sub Printatt(what_to_print As String)
Dim vWord As Object
Dim vWDoc As Object
Set vWord = CreateObject("Word.Application")
Set vWDoc = vWord.Documents.Open(what_to_print)
vWord.Visible = True
vWDoc.PrintOut
vWDoc.Close False
Set vWDoc = Nothing
vWord.Application.Quit False
Set vWord = Nothing
End Sub

[geekgirlau]

What about counting the files in the folder to set the value of i?


Sub SaveAttachments()
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim avDate() As String
Dim vDate As String
Dim i As Long

Const myPath As String = "C:\Data\Bijlagen\"
ReDim Preserve avDate(3)

Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myFolder = myFolder.Folders("Facturen")

i = CountFiles(myPath)

For Each myItem In myFolder.Items
If myItem.UnRead = True Then
avDate = Split(CStr(myItem.ReceivedTime), "/")
vDate = Mid(avDate(2), 1, 4) & "-" & avDate(1) & "-" & avDate(0)
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
i = i + 1
myAttachment.SaveAsFile (myPath & vDate & " - " & i & " - " & _
myAttachment.Filename)
If UCase(Right(myAttachment.Filename, 3)) = "DOC" Then
Printatt (myPath & vDate & " - " & i & " - " & myAttachment.Filename)
End If
Next
myItem.UnRead = False
End If
End If
Next
End Sub
Sub Printatt(what_to_print As String)
Dim vWord As Object
Dim vWDoc As Object
Set vWord = CreateObject("Word.Application")
Set vWDoc = vWord.Documents.Open(what_to_print)
vWord.Visible = True
vWDoc.PrintOut
vWDoc.Close False
Set vWDoc = Nothing
vWord.Application.Quit False
Set vWord = Nothing
End Sub

Function CountFiles(strPath As String) As Integer
Dim fso As Object
Dim fldr As Object


Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(strPath)

CountFiles = fldr.Files.Count

Set fldr = Nothing
Set fso = Nothing
End Function

[Charlize]

Thanks for the idea :thumb . Why haven't I thought of that :banghead: ?

Works like a charm now :cloud9: .
Charlize

[geekgirlau]

I'm glad it worked for you - don't forget to mark the thread as solved.