Open all files in a folder using list of password

Dear all,

I am a beginner in using macro excel for automation.

I have nearly 100 of excel files with password. I would like to do as follows.

- Step 1: I will choose Input folder contains all excel files.
- Step 2: I will choose Output folder contains all output excel file.
- Step 3: File structure and password are as follows.

File structure Password
PV*.xlsx PV
JP*.xls JP
PIT calculation*01-20*.xlsx 0120
PIT calculation*02-20*.xlsx 0220
PIT calculation*03-20*.xlsx 0320
PIT calculation*04-20*.xlsx 0420
PIT calculation*05-20*.xlsx 0520
PIT calculation*06-20*.xlsx 0620
PIT calculation*07-20*.xlsx 0720
PIT calculation*08-20*.xlsx 0820
PIT calculation*09-20*.xlsx 0920
PIT calculation*10-20*.xlsx 1020
PIT calculation*11-20*.xlsx 1120
PIT calculation*12-20*.xlsx 1220

Step 4: if the input file in .xls, convert it to .xlsx

I have write a code as follows but when I run it, it seems endless run. Please help to correct my code. Thank you.

Please Login or Register  to view this content.

• As yet stated according to your 'File structure' list only 2 files can be treated so you must first correct this list …
  
  
• On my side the Dir VBA function can not work 'cause of the asian characters in some files names so according to your attachment :
  
  

PHP Code: 

Sub Demo1()
        Dim P, F$, oF As Object, V
    With Sheet1
            P = .[TRANSPOSE(B2:B3&IF(RIGHT(B2:B3,1)<>"\","\",""))]
        With .Range("A8", .[B7].End(xlDown)).Columns
            F = "TRANSPOSE(IF(ISNUMBER(MATCH(" & .Item(1).Address(, , , True) & ",{""#""},0))," & .Item(2).Address(, , , True) & "))"
        End With
    End With
    With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(P(1)) And .FolderExists(P(2)) Then
                Application.DisplayAlerts = False:  Application.ScreenUpdating = False
            For Each oF In .GetFolder(P(1)).Files
                    V = Filter(Evaluate(Replace(F, "#", oF.Name)), False, False)
                If UBound(V) = 0 Then
                    With Workbooks.Open(oF.Path, , , , V(0))
                        .SaveAs P(2) & Left(oF.Name, InStrRev(oF.Name, ".")) & "xlsx", 51, Empty
                        .Close
                    End With
                End If
            Next
                Application.DisplayAlerts = True:  Application.ScreenUpdating = True
        Else
            Beep
        End If
    End With
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

Thanks for the rep' !

So the file name structure is still bad as a ".xlsx" file can not be a ".xlsx " file !

Again, just correct the list and no need to review the code as it well works on my side once the list is correct,
the reason why of my warning about this list …