In Outlook, Browse dialog box to select any folder

[CR Anandan]

Hi can any one suggest me, that in below mentioned code I am limited only Inbox folder. I want an Browse Folder dialog box should open and user can select any folder and the below mention program will continue...


Pls see the attachment User Create monthly folder with Airlines name, So i do nt want to stick with Inbox folder user can chose any folder.

  Dim ns As Namespace
  Dim Inbox As MAPIFolder
  Dim Item As Object
  Dim Atmt As Attachment
  Dim FileName As String
  Dim i As Integer
  Dim z As Integer
  Dim a As Integer
  
   
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
  
    If Inbox.Items.count = 0 Then       ' Check Inbox for messages and exit of none found
        MsgBox "There are no messages in the Inbox.", vbInformation, _
               "Nothing Found"
        Exit Sub
    End If
                    
         
                          
' Check each message for attachments

For Each Item In Inbox.Items ' Save any attachments found


            For Each Atmt In Item.Attachments  ' This path must exist!
            If Right(Atmt.FileName, 4) = "xlsx" Then
                'MsgBox "Exist XLSX......"
            End If
          
                      If Right(Atmt.FileName, 3) = "xls" Or Right(Atmt.FileName, 4) = "xlsx" Then             ''''''  Save Only Specific File Types
                          If UCase(Left(Atmt.FileName, 22)) = UCase("Daily Flight Programme") Then     ' file name GB Meals
                                If FileThere(filepath & Atmt.FileName) = "File Found" Then    ' CHECK FILE EXIST WITH SAME NAME
                                      
                                     ' MsgBox FileThere(filepath & Atmt.FileName)
                                       Name filepath & Atmt.FileName As filepath & Left(Atmt.FileName, Len(Atmt.FileName) - 4) & "_Revised_" & i & "_.xls"                '"a_" & Atmt.FileName    ' RENAME THE FILE xls
                                       'Name filepath & Atmt.FileName As filepath & Left(Atmt.FileName, Len(Atmt.FileName) - 5) & "_Revised_" & i & "_.xlsx"                '"a_" & Atmt.FileName    ' RENAME THE FILE xlsx
                                       ' Name filepath & Atmt.FileName As filepath & "a_" & Atmt.FileName    ' RENAME THE FILE
                                        FileName = filepath & Atmt.FileName

.....


This Code is to check all mail Inbox of outlook and save all the PDF in specif location.

 

[CR Anandan]

Attachment missed...in above

Now attached....

 

[Deepak]

Pls take care of code tagging.

 

[CR Anandan]

Can't get u...

 

[Deepak]

I haven't checked your code!
But have suggestion for the same.

http://chandoo.org/forum/threads/re...ils-outlook-using-excel-vba.11773/#post-69384

 

[Deepak]

Can't get u...

Code must be tagged! check your post how it is looking now!