Đoạn này nó không phân biệt file có WriteResPassword hay không?
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sFilename & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
Sub GetTables()
Dim oConn As Object 'ADO.Connection
Dim sFilename
sFilename = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If sFilename = False Then Exit Sub
'Const sFilename As String = "C:\test\test.xls"
Dim oCat As Object 'ADOX.Catalog
Dim tbl As Object 'ADOX.Table
Dim vecSheets As Variant, vecSheet2 As Variant
Dim iRow As Long, iRow2 As Long
Dim sConnString As String
Dim sTableName As String
Dim cLength As Integer
Dim iTestPos As Integer
Dim iStartpos As Integer
'sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sFilename & ";" & _
"Extended Properties=Excel 8.0;"
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sFilename & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
Set oConn = CreateObject("ADODB.Connection")
'KIEM TRA FILE CO PASS KO?
On Error Resume Next
oConn.Open sConnString
If Err <> 0 Then
MsgBox "Có pass file"
iRow2 = 1
With UserForm1.ListBox2
.AddItem "* Password to Open:"
.AddItem "* Password to Modify:"
.List(0, 1) = " co password"
.List(1, 1) = " ??????"
End With
GoTo THOAT
End If
On Error GoTo 0
'KIEM TRA FILE CO WRITE KO?
sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sFilename & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";" 'Write
On Error Resume Next
oConn.Open sConnString
If Err <> 0 Then
MsgBox "Loi ko MODIFY dduoc, so: " & Err
iRow2 = 1
With UserForm1.ListBox2
.AddItem "* Password to Open:"
.AddItem "* Password to Modify:"
.List(0, 1) = " Khong password"
.List(1, 1) = " ??????"
End With
GoTo THOAT2
End If
On Error GoTo 0
...
THOAT:
oConn.Close
Set oCat = Nothing
Set oRS = Nothing
Set oConn = Nothing
If iRow > 0 Or iRow2 > 0 Then
With UserForm1
If iRow > 0 Then .ListBox1.List = vecSheets
.Show
End With
End If
End Sub