Các hàm tự tạo thao tác với các tập tin, bảng tính & trang tính (1 người xem)

[handung107]

Lê Văn Duyệt sưu tầm từ Internet​

VBA có rất nhiều hàm built-in hữu dụng (useful built-in functions), nhưng thiếu khả năng để thực hiện một số công việc chung. Ví dụ như, nếu ứng dụng của bạn cần xem xét một File có tồn tại hay không bạn phải viết một hàm người dùng để làm điều này.

Sau đây là 6 hàm VBA rất đơn giản, nhưng lại rất hữu dụng. Bạn chỉ việc đơn giản copy mã và dán vào trong module của bạn.

FileExists - Trả về TRUE nếu File tồn tại.

FileNameOnly- Tách tên File từ đường dẫn.

PathExists - Trả về TRUE nếu đường dẫn tồn tại.

RangeNameExists - Trả về TRUE nếu tên range tồn tại.

SheetExists - Trả về TRUE nếu tên sheet tồn tại.

WorkBookIsOpen - Trả về TRUE nếu workbook đã mở.

 

[handung107]

Hàm kiểm tra sự tồn tại của File​

Private Function FileExists(fname) As Boolean
' Trả về TRUE nếu File tồn tại'
 Dim x As String

 x = Dir(fname)
 If x <> "" Then FileExists = True _
     Else FileExists = False
End Function

 

[handung107]

Hàm tách tên File từ đường dẫn​

Private Function FileNameOnly(pname) As String
' Tách tên File từ đường dẫn'
 Dim i As Integer, length As Integer, temp As String

 length = Len(pname)
 temp = ""
 For i = length To 1 Step -1
    If Mid(pname, i, 1) = Application.PathSeparator Then
        FileNameOnly = temp:                    Exit Function
    End If
    temp = Mid(pname, i, 1) & temp
 Next i
 FileNameOnly = pname
End Function

 

[handung107]

Hàm kiểm tra sự tồn tại của đường dẫn​

Private Function PathExists(pname) As Boolean
' Trả về TRUE nếu đường dẫn tồn tại'
 Dim x As String
 On Error Resume Next

 x = GetAttr(pname) And 0
 If Err = 0 Then PathExists = True _
         Else PathExists = False
End Function

 

[handung107]

Hàm kiểm tra sự tồn tại Tên của một khoảng (Range Name)​

Private Function RangeNameExists(nname) As Boolean
' Trả về TRUE nếu tên range tồn tại'
 Dim n As Name

 RangeNameExists = False
 For Each n In ActiveWorkbook.Names
    If UCase(n.Name) = UCase(nname) Then
        RangeNameExists = True:                   Exit Function
    End If
 Next n
End Function

 

[handung107]

Hàm kiểm tra sheet có tồn tại hay không​

Private Function SheetExists(sname) As Boolean
' Trả về TRUE nếu tên sheet tồn tại'
 Dim x As Object
 On Error Resume Next
 
 Set x = ActiveWorkbook.Sheets(sname)
 If Err = 0 Then SheetExists = True _
           Else SheetExists = False
End Function

 

[handung107]

Hàm kiểm tra Workbook có mở hay không​

Private Function WorkbookIsOpen(wbname) As Boolean
' Trả về TRUE nếu workbook đã mở'
 Dim x As Workbook
 On Error Resume Next

 Set x = Workbooks(wbname)
 If Err = 0 Then WorkbookIsOpen = True _
            Else WorkbookIsOpen = False
End Function

Hy vọng rằng các hàm trên sẽ giúp ích cho các bạn phần nào trong lập trình VBA cho Excel.
Sưu tầm từ internet. Mọi góp ý xin các bạn gởi về địa chỉ mail sau:

levanduyet@yahoo.com

 

[handung107]

Hàm xác định một file đang được sử dụng (hay mở)

Hàm xác định một file đang được sử dụng (hay mở)​

Lê Văn Duyệt (st từ Internet)​

Với hàm dưới đây bạn có thể biết được tập tin có đang được các chương trình khác sử dụng hay không. Hàm sẽ trả về True nếu không thể truy cập hoàn toàn (full access).

Function FileAlreadyOpen(FullFileName As String) As Boolean 
' Tra ve True neu tap tin FullFileName dang duoc cac chuong trinh khac su dung hay mo' 

 Dim f As Integer 
  f = FreeFile 
 On Error Resume Next 
 Open FullFileName For Binary Access Read Write Lock Read Write As #f 
 Close #f 
' Neu co loi thi co nghia tai lieu dang duoc mo'
 If Err.Number <> 0 Then 
    FileAlreadyOpen = True 
    Err.Clear 
 'MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description'
 Else 
      FileAlreadyOpen = False 
 End If 
 On Error GoTo 0 
End Function

 

[handung107]

Tên tập tin và tên thư mục

Hàm trả về tên đầy đủ của tập tin hay thư mục​

Hàm dưới đây có thể được sử dụng để trả về tên tập tin hay tên thư mục từ tên đầy đủ (full file name):

Function FileOrFolderName(InputString As String, ReturnFileName As Boolean) As String 
 Dim i As Integer, FolderName As String, FileName As String 
 i = 0 
 While InStr(i + 1, InputString, Application.PathSeparator) > 0 
    i = InStr(i + 1, InputString, Application.PathSeparator) 
 Wend 
 If i = 0 Then 
     FolderName = CurDir 
 Else 
     FolderName = Left(InputString, i - 1) 
 End If 
 FileName = Right(InputString, Len(InputString) - i) 
 If ReturnFileName Then 
     FileOrFolderName = FileName 
 Else 
     FileOrFolderName = FolderName 
 End If 
End Function

Thủ tục sau kiểm tra hàm FileOrFolderName

[B]Sub TestFileOrFolderName() [/B]
 MsgBox FileOrFolderName(ThisWorkbook.FullName, False), , "Ten thu muc cua  Workbook nay la:" 
 MsgBox FileOrFolderName(ThisWorkbook.FullName, True), , "Ten tap tin cua Workbook nay la:" 
[B]End Sub[/B]

 

[handung107]

Liệt kê các tập tin trong thư mục

Liệt kê các tập tin trong thư mục​

Trong Office 97 hay các phiên bản sau đó, bạn dễ dàng lấy danh sách các tập tin và thư mục con trong một thư mục:

Function CreateFileList(FileFilter As String, IncludeSubFolder As Boolean) As Variant 
' tra ve ten t?p tin day du cho cac files thoa dieu kien trong thu muc hien hanh'
 Dim FileList() As String, FileCount As Long 
 CreateFileList = "" :                         Erase FileList 
 If FileFilter = "" Then FileFilter = "*.*" ' tat ca cac tap tin
 With Application.FileSearch 
     .NewSearch :                            .LookIn = CurDir 
     .FileName = FileFilter 
     .SearchSubFolders = IncludeSubFolder 
     .FileType = msoFileTypeAllFiles 
     If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) _
            = 0 Then Exit Function 
     ReDim FileList(.FoundFiles.Count) 
     For FileCount = 1 To .FoundFiles.Count 
          FileList(FileCount) = .FoundFiles(FileCount) 
     Next FileCount 
    .FileType = msoFileTypeExcelWorkbooks 
 End With 
 CreateFileList = FileList 
 Erase FileList 
 End Function

Ví dụ sau kiểm tra hàm CreateFileList ở trên:

[B]Sub TestCreateFileList() [/B]
 Dim FileNamesList As Variant, i As Integer 
'ChDir "C:\My Documents" [COLOR="Blue"]' Chuyen thu muc hien hanh[/COLOR] 

FileNamesList = CreateFileList("*.*", False)'[COLOR="blue"]Thuc hien tim kiem File bao gom cac thu muc con[/COLOR]
[COLOR="blue"]' Dua ra ket qua[/COLOR]
 Range("A:A").ClearContents 
 For i = 1 To UBound(FileNamesList) 
     Cells(i + 1, 1).Formula = FileNamesList(i) 
 Next i 
[B]End Sub[/B]

 

[vanquangdy]

các bác cho mình hỏi: Trong excel có code nào trong VBA mà không cho copy flie excel sang một máy khác, và cứ mỗi lần copy thì sẽ thay đổi số đăng ký sử dụng. Ai biết chỉ dùm . Thank

 

[haonlh]

Các ví dụ đều hay.
Nhưng chọn và chép vô macro thì các dấu cách đều có mã 160, không chạy được

vậy phải tìm và thay thế chúng bằng dấu cách thông thường (mã 32)

Cụ thể: sau khi chép vô macro, chọn 1 kí tự trắng ở đầu dòng, gõ Ctrl - H, mục Find what bỏ qua (gõ phím Tab), mục Replace with nhập 1 dấu cách, chọn nút Replace All