[Tool Ex Test]Mở một file excel khác và lấy thông tin ở file đó Workbooks.Open

tuhocvba

Administrator
Thành viên BQT
Bài viết dựa trên nguồn:
Mã:
http://officetanaka.net/excel/vba/file/file01.htm
1. Mở file
Khi mở file excel khác ta dùng hàm Workbooks.Open
Đối với excel, ta có thể mở đồng thời nhiều file excel (workbook), khi đó workbook là đối tượng để chúng ta thao tác.
Ví dụ ta có code như sau:
Mã:
Sub Sample1()

    Workbooks.Open "C:\Users\jpnfriend.net\Desktop\VBA\tap6c.xlsx"

End Sub
Chú ý rằng workbook vừa mới được mở thì đó là workbook đang được Active, tức là đang được chờ nhập dữ liệu.
Do đó để không nhầm lẫn với workbook khác, ta cần lấy tên workbook ngay khi nó được mở.
Mã:
Sub Sample1()
    Dim wb As String
    Workbooks.Open "C:\Users\jpnfriend.net\Desktop\VBA\tap6b.xlsx"
    wb = ActiveWorkbook.Name
    MsgBox Workbooks(wb).Sheets(1).Cells(2, 1).Value
    Workbooks(wb).Close
End Sub
Chương trình trên thực hiện lấy dữ liệu từ workbook được mở và hiện ra thông báo bằng hàm Msgbox.

Tuy nhiên bây giờ chúng ta xét tới một vấn đề khác, đó là file chỉ định mở không tồn tại.
Lúc này macro sẽ báo lỗi.
Bạn cần đăng nhập để thấy hình ảnh

2. Phớt lờ lỗi để chạy sang dòng lệnh tiếp theo
Để phớt lờ cảnh báo lỗi, chương trình vẫn có thể chạy sang dòng lệnh khác thì ở đầu chương trình chúng ta khai báo
On Error Resume Next

Mã:
Sub Sample1()
    Dim wb As String
    On Error Resume Next
    Workbooks.Open "C:\Users\jpnfriend.net\Desktop\VBA\tap6c.xlsx"
    wb = ActiveWorkbook.Name
    MsgBox Workbooks(wb).Sheets(1).Cells(2, 1).Value
    Workbooks(wb).Close
End Sub
Điều tệ hại sẽ xảy ra, do file tap6c.xlsx không tồn tại, tuy nhiên do bị phớt lờ lỗi, cho nên câu lệnh tiếp theo được thực thi.
Lúc này thay vì wb = tap6c.xlsx, do workbook đang được active chính là file macro cho nên wb sẽ là tên file của macro đang thực thi lệnh.
Mã:
 wb = ActiveWorkbook.Name
Và vì thế file macro sẽ bị đóng, như trong video dưới đây.
Bạn cần đăng nhập để thấy đa phương tiện

Vì lệnh On Error Resume Next sẽ phớt lờ toàn bộ lỗi nếu có trong chương trình, điều này sẽ gây khó khăn trong việc phát hiện các lỗi khác mà chúng ta mong muốn xuất hiện nếu bị lỗi thì hãy báo để chúng ta biết.
Trong trường hợp này, chúng ta sẽ sử dụng lệnh On Error Goto 0
Mã:
Sub Sample1()
    Dim wb As String
    On Error Resume Next
    Workbooks.Open "C:\Users\jpnfriend.net\Desktop\VBA\tap6c.xlsx"
    On Error GoTo 0
    Workbooks.Open "C:\Users\jpnfriend.net\Desktop\VBA\tap6c.xlsx"
    wb = ActiveWorkbook.Name
    MsgBox Workbooks(wb).Sheets(1).Cells(2, 1).Value
    Workbooks(wb).Close
End Sub
Dòng lệnh thứ 4 sẽ không bị báo lỗi do lệnh On Error Resume Next phớt lờ toàn bộ lỗi nếu có trong chương trình.
Tuy nhiên dòng lệnh thứ 5 đã reset lại, nếu có lỗi thì báo như bình thường.
Vì vậy dòng lệnh thứ 6 tạo nên lỗi và ngay lập tức chương trình cảnh báo lỗi mà không phớt lờ nữa.
Bạn cần đăng nhập để thấy đa phương tiện
3. Kiểm tra file có tồn tại hay không trước khi tiến hành mở file.
Từ vấn đề nêu ở trên, chúng ta thấy rằng cần phải kiểm tra file chúng ta dự định mở có thực sự tồn tại hay không, nhằm tránh bị lỗi.
Đoạn code dưới đây sẽ giải quyết vấn đề đó.
Chú ý dòng lệnh số 4 dưới đây.
Mã:
Sub Sample2()
    Dim lk    As String
    lk = "C:\Users\jpnfriend.net\Desktop\VBA\tap6b.xlsx"
    If Dir(lk) = "" Then
        MsgBox "File khong ton tai"
    Else
       Workbooks.Open lk
    End If
End Sub
Bạn cần đăng nhập để thấy đa phương tiện
4. Mở file do người dùng chỉ định.
Chúng ta không chỉ định file được mở ở trong code, có một phương pháp đó là chúng ta sẽ nhận được file cần mở từ sự
lựa chọn của người dùng. Hơn thế nữa, người dùng còn có thể xác thực file thông qua hộp DialBox.
Mã:
Sub Sample_tuhocvba()
    Dim OpenFileName As String
    OpenFileName = Application.GetOpenFilename("File excel,*.xls?")
    If OpenFileName <> "False" Then
        Workbooks.Open OpenFileName
    End If
End Sub
Bạn cần đăng nhập để thấy đính kèm


5. Đối sách trong việc đang tồn tại file trùng tên được mở rồi.
Excel cho phép mở đồng thời nhiều workbook (nhiều file excel cùng lúc), nhưng không được trùng tên.
Vì vậy, nếu đã có một file trùng tên được mở trước đó thì lỗi sẽ xảy ra khi ta cố mở một file trùng tên.
Bạn cần đăng nhập để thấy đính kèm

Dưới đây là giải pháp, chúng ta sẽ kiểm tra lần lượt từng workbook đang được mở, xem có file nào trùng tên
với file ta dự định mở hay không.
Mã:
Sub Sample5()
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name = "Book1.xlsx" Then
            MsgBox "Book1 dang duoc mo" &chr(10) & "Vui long close file Boo1"
            Exit Sub
        End If
    Next wb
    Workbooks.Open "C:\Book1.xlsx"
End Sub
Chúng ta chú ý dòng lệnh If wb.Name = "Book1.xlsx", ghi đầy đủ cả phần định dạng file.
Chúng ta đừng quên điều này, chớ có ghi là If wb.Name = "Book1" .

6. Tổng kết:
Cuối cùng, thuật toán để mở một file của chúng ta là:
//File định mở có tồn tại hay không? -> Không tồn tại: Kết thúc chương trình
//File trùng tên không đang được mở đúng không? -Không-> Kết thúc chương trình

Bạn cần đăng nhập để thấy đính kèm

Mã:
Sub Sample_tuhocvba2()
    Dim buf As String, wb As Workbook
    Const Target As String = "C:\Book1.xlsx"
    ''Kiem tra file ton tai hay khong?
    buf = Dir(Target)
    If buf = "" Then
        MsgBox Target & vbCrLf & "khong ton tai", vbExclamation
        Exit Sub
    End If
    ''Kiem tra file trung ten co dang open hay khong
    For Each wb In Workbooks
        If wb.Name = buf Then
            MsgBox buf & vbCrLf & "dang duoc open", vbExclamation
            Exit Sub
        End If
    Next wb
    ''Mo file
    Workbooks.Open Target
End Sub
Lời bình người dịch: Có một lần, người ta yêu cầu chúng tôi viết một chương trình VBA. Rồi sau đó chúng tôi nhận phản hồi là chương trình lỗi.
Lý do là, file input đặt mật khẩu, chương trình không mở được file input này nên sinh ra lỗi. Vì vậy, thuật toán ở trên để làm chặt hơn nữa, phải kiểm tra
file có bị đặt mật khẩu hay không? Hoặc bạn phải xác nhận với người yêu cầu, là file của họ có đặt mật khẩu hay không?
 

tuhocvba

Administrator
Thành viên BQT
7. Giới thiệu về Application.GetOpenFilename
Mã:
Sub Sample1()
    Dim OpenFileName As String
    OpenFileName = Application.GetOpenFilename("Microsoft Excel,*.xls?")
    If OpenFileName <> "False" Then
         Workbooks.Open OpenFileName
    Else
        MsgBox "Ban can chon file"
    End If
End Sub
Chương trình trên chúng ta sẽ nhận được hành động lựa chọn file để mở của người dùng.
Trong trường hợp người dùng ấn Cancel không chọn file thì đường link của file là OpenFileName sẽ là False, khi đó sẽ ra hộp thoại yêu cầu người dùng cần chọn file.

Các thông số của phương thức GetOpenFileName như dưới đây:
GetOpenFilename FileFilter, FilterIndex, Title, ButtonText, MultiSelect
Trong đó FileFilter là thông số bắt buộc, loại định dạng file nào sẽ được hiển thị và liệt kê ra.
Các thông số khác có thể lược bỏ, khuyến nghị nên dùng thêm thông số Title, đây là thông số thể hiện tiêu đề cửa sổ lựa chọn file khi mở ra.
Chú ý các tham số được nhận biết trong phạm vi của "".
Đúng: "Microsoft Excel,*.xls?"
Sai: "Microsoft Excelブック", "*.xls?"
Ví dụ:

Bạn cần đăng nhập để thấy đính kèm

Nếu cho nhiều định dạng file vào ô lựa chọn chúng ta có:
Bạn cần đăng nhập để thấy đính kèm

Cho hiển thị tiêu đề chúng ta có:
Mã:
Sub Sample3()
    Dim OpenFileName As String
 
    OpenFileName = Application.GetOpenFilename("Excel,*.xls", , "Mo file cho toi")
    If OpenFileName <> "False" Then
        Workbooks.Open OpenFileName
    End If
End Sub
Các bạn xem thêm video ở đây:
Bạn cần đăng nhập để thấy đa phương tiện
 

Euler

Administrator
Thành viên BQT
Cách mở file như thế này có một cái hơi bất tiện là folder được mở ra nhiều khi không gần với file cần mở. Khắc phục điều này, tôi có code như sau:
Mã:
Sub Sample3()
    Dim OpenFileName As String
    ChDrive "D"
    ChDir "D:\VBA"
    OpenFileName = Application.GetOpenFilename("Microsoft Excel,*.xls?")
    If OpenFileName <> "False" Then
        Workbooks.Open OpenFileName
    Else
        MsgBox "Ban da an Cancel"
    End If
End Sub
Chương trình trên có điểm đặc biệt đó là, nó sẽ điều hướng Application.GetOpenFilename tới ổ D->D:\VBA
Như vậy sẽ thuận lợi hơn cho người dùng khi chọn file.
 

giaiphapvba

Administrator
Thành viên BQT
Đoạn code này cần chú ý:
Mã:
lk = "C:\Users\jpnfriend.net\Desktop\VBA\tap6b.xlsx"
    If Dir(lk) = "" Then
        MsgBox "File khong ton tai"
Code này chỉ có tác dụng là đường link liền mạch. Nếu như file được cất trong folder mà tên folder có khoảng trống thì hỏng. Ví dụ tên folder như sau: NewFolder4 (27072019). thì sẽ ra kết quả không đúng, dù file đúng là có tồn tại.
Để khắc phục điều này, thì sử dụng FileSystemObject sẽ mạnh hơn và triệt để hơn.
 

tuhocvba

Administrator
Thành viên BQT
Nói về việc mở file, thật ra cũng cần kiểm tra file định mở đã đang được mở hay chưa. Nói về vấn đề này, tôi đã thử tìm code trên mạng cũng có khá nhiều, nhưng đây là code có thể nói là đơn giản nhất. Ai biết thì tiếp tục chia sẻ:
Mã:
Function BookOpen(ByVal linkfile As String) As Boolean
    Dim oBk As Workbook
    On Error Resume Next
    Set oBk = Workbooks(Dir(linkfile))
    On Error GoTo 0
    If oBk Is Nothing Then
        BookOpen = False
    Else
        BookOpen = True
    End If
End Function
 

vbano1

SMod
Thành viên BQT
Phát triển ý từ bài viết :
Hầu hết khi select file thì mọi người đều muốn select file nằm cùng thư mục với file Tool. Do đó, mong muốn điều hướng về thư mục chứ file Tool khi thực hiện select file. Nếu nằm ở thư mục khác thì người dùng tự ý chỉnh.
Vì vậy ta có cách giải quyết như sau:
Mã:
Sub Change_Drive(ByVal strPath As String)

    Dim strDrive As String

    With Excel.Application
    
        If InStr(1, strPath, ":", vbTextCompare) = 0 Then Exit Sub
    
        strDrive = Left(strPath, InStr(1, strPath, ":", vbTextCompare) - 1)
        
        If Len(strDrive) = 1 Then
        
            ChDrive strDrive
            ChDir strPath
            
        End If

    End With
    
End Sub
Cách sử dụng:
Thủ tục sau sẽ lấy đường link của file mà người dùng select. Khi người dùng select file thì sẽ được điều hướng tới thư mục chứa file Tool.
Mã:
Sub laylinktext(ByRef strFilepath As String)
    With Excel.Application
    
        Call Change_Drive(.ThisWorkbook.Path)
            
        strFilepath = .GetOpenFilename("File log type tuhocvba.net (*.txt), *.txt", , "Select file log")
    End With

End Sub
Thủ tục main có code như là:
Mã:
Sub main()
    Dim lk as string
    Call laylinktext(lk) 'Duong link file se duoc gan vao bien lk'
End Sub
 

tuhocvba

Administrator
Thành viên BQT
Thủ tục Change Drive ở trên chưa làm việc tốt với đường link chứa tiếng việt có dấu.
Vì vậy bổ sung code của Euler :
Mã:
Sub main()

Dim shell
Set shell = CreateObject("WScript.Shell")
shell.currentDirectory = ThisWorkbook.path

strFilepath = Excel.Application.GetOpenFilename("File log type tuhocvba.net (*.txt), *.txt", , "Select file log")

End Sub
 

knell741

Yêu THVBA
Xin chào mọi người,
Việc mở thư mục, hay file trên máy tính cá nhân, mình có làm công việc với các file chứa trên ổ chung trên mạng công ty, thì không cách nào cho GetOpenFilename nó mở trực tiếp đến thư mục trên ổ chung này được, có cách nào khắc phục không ạ?
 

knell741

Yêu THVBA
Bí quá thì bác chịu khó copy về máy cá nhân. Chắc nó cũng không tốn mấy thời gian đâu mà
À, mình muốn tự động ấy, mình đã tìm được giải pháp, tuy nhiên có phát sinh là trường hợp link chứa ký tự unicode thì chịu :D
Mã:
Option Explicit
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
 

NhanSu

SMod
Thành viên BQT
@knell741 mình nghĩ có thể làm bằng cách gán đường dẫn thành ổ đĩa bằng lệnh net use hoặc subst. Ví dụ
Mã:
net use z: abc
Lệnh trên gán đường dẫn abc trên mạng thành ổ đĩa Z:
Để truy cập file excel a.xlsx ở thư mục này chỉ cần nhập đường dẫn z:\a.xlsx
Bạn thử xem có được không, mình không có máy mạng.
 

vbano1

SMod
Thành viên BQT
À, mình muốn tự động ấy, mình đã tìm được giải pháp, tuy nhiên có phát sinh là trường hợp link chứa ký tự unicode thì chịu :D
Mã:
Option Explicit
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Tôi không có điều kiện để thử, bạn chú ý phải thêm dấu "\" vào cuối đường dẫn.
 
Top