Mở hộp thoại file với đường dẫn mặc định

  • Thread starter Thread starter ThuNghi
  • Ngày gửi Ngày gửi
Liên hệ QC

ThuNghi

Hãy cho rồi sẽ nhận!
Thành viên đã mất
Tham gia
16/8/06
Bài viết
3,808
Được thích
4,449
Tôi có code sau
PHP:
Sub MoFile()
....
myPath = ThisWorkbook.Path
ChDir myPath
'mo file
Fname = Application.GetOpenFilename(filefilter:="excel files(*.xls),*.xls", MultiSelect:=True)
....
end sub

Nên thêm câu lệnh nào để khi mở file để lấy dữ liệu sẽ default là folder chứa file này. (myPath). File này có thể ở nhiều đĩa, folder khác nhau.
Ví dụ, file này nằm ở F:\Baocao\2008
thì dòng lệnh này
Fname = Application.GetOpenFilename(filefilter:="excel files(*.xls),*.xls", MultiSelect:=True)
sẽ mở F:\Baocao\2008
Xin cám ơn!
 
Chào anh, tạm thời anh thử dùng cách này xem sao
Mã:
PathTemp = Application.DefaultFilePath
Application.DefaultFilePath = "F:\Baocao\2008"
'.............
Application.DefaultFilePath = PathTemp
 
Upvote 0
Bạn thử dùng code này xem sao nhé, code đang chạy trên Office2003, nếu không nhầm thì có thể chạy trên cả OfficeXP.
Mã:
Sub MoFile()
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = Application.Path
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls"
        .Show
        For i = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(i)
        Next
    End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn thử dùng code này xem sao nhé, code đang chạy trên Office2003, nếu không nhầm thì có thể chạy trên cả OfficeXP.
Mã:
Sub MoFile()
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = Application.Path
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls"
        .Show
        For i = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(i)
        Next
    End With
End Sub
Rất cám ơn bạn, bạn HD thêm một chút, phải khai biến Fname là gì theo code sau, vận dụng code của bạn, tôi chế thêm.
PHP:
Option Explicit
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, rgnB As Range
Dim shName As String, wName As String
Dim endR As Integer, wbName As String
Dim FolderName As String
Dim mypath As String
Dim Fname As Variant
Dim SourceWb As Workbook, TgtWb As Workbook
Dim Data As Range
Public Sub LayDuLieuVD()
With Application
       .DisplayAlerts = False
       .ScreenUpdating = False
       .Calculation = xlCalculationManual
End With
Set SourceWb = ThisWorkbook
mypath = ThisWorkbook.Path
'mo file
With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = mypath 'Application.Path
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls"
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Ban chua chon file"
            Exit Sub
        End If
        Fname = .SelectedItems(1)
End With
'***Xoa ca sheet*********
    Sheets("CDoi").Range("A7:L81").ClearContents
'***Mo file
     Workbooks.Open Filename:=Fname
      Set TgtWb = ActiveWorkbook
            TgtWb.Activate
            shName = "CDOI"
            If SheetExists(shName) = True Then
                Sheets("CDoi").Select
                endR = Range("A65000").End(xlUp).Row + 3 'dong cuoi cot sl
                SourceWb.Sheets("CDoi").Range("A7:L" & endR).Value = Range("A7:L" & endR).Value
                SourceWb.Sheets("CDoi").Range("A7:B" & endR - 3).Name = "DMTK"
            End If
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
Bạn chỉnh lại code trên hộ tôi với.
Code trên là mở 1 file trong cùng folder và copy sh Cdoi vao Cdoi.
Cám ơn nhiều.
 
Upvote 0
- Biến Fname: Nếu mỗi lần bạn chỉ mở 1 file thì bạn chỉnh lại .AllowMultiSelect False để người dùng chỉ chọn được 1 file duy nhất, khi đó biến Fname là kiểu String và gán như trong code của bạn là Fname = .SelectedItems(1), Trong trường hợp bạn muốn mở nhiều file 1 lúc, thì Fname có thể dùng kiểu FileDialogSelectedItems, kiểu này giống như 1 mảng, có thể duyệt từ 1 đến Fname.Count và các phẩn tử là Fname(i).
- Tôi chưa hiểu cấu trúc của Sheet CDOI của bạn như nào nên rất khó để sửa được code cho đúng ý của bạn.
- Ở đây tôi thấy ở Sheet CDOI chỉ xóa vùng A1:L81, chỗ này tôi thấy hơi có vấn đề, nếu Sheet CDOI này chỉ chứa đúng phần dữ liệu cần copy từ file mới sang thì có thể xóa hẳn Sheet này đi, thay vì xóa đúng vùng dữ liệu đó, hoặc tìm chính xác vùng dữ liệu giống như bạn tìm ở Sheet nguồn để xóa thì sẽ chính xác hơn.(Để chắc ăn thì có nên kiểm tra xem WB hiện tại có tồn tại sheet CDOI không? nếu không thì phải tạo ra?????)
- Tương tự, nếu ở Sheet CDOI nguồn, nếu dữ liệu của cả nguồn và đích chỉ có đúng phần cần copy thì có thể copy cả sheet sẽ nhanh hơn, sau đó mới xác định vùng dữ liệu để định nghĩa Name sau.
 
Upvote 0
Cám ơn Bạn nhiều lắm, tôi cắt bớt phần test Sh tồn tại.
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = myPath 'Application.Path
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel files", "*.xls"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Ban chua chon file"
Exit Sub
End If
Fname = .SelectedItems(1)
End With
'***Xoa ca sheet*********
Sheets("CDoi").Range("A7:L81").ClearContents
'***Mo file
Workbooks.Open Filename:=Fname
Set TgtWb = ActiveWorkbook
TgtWb.Activate
...
Vậy chỉ cần như vậy là OK
Trong code trên khai là
Dim Fname As Variant
Như vậy có OK hay là
Dim Fname As String
Bạn giúp tôi phần này nữa, nếu
Workbooks.Open Filename:=Fname
Set TgtWb = ActiveWorkbook

Có thể bớt 1 dòng lệnh, vừa mở vừa set luôn có được không
Set TgtWb = Workbooks.Open Fname
 
Upvote 0
- Về biến Fname, như vậy là bạn xác định là chỉ cho chọn 1 file mỗi lần, ở đây nếu bạn để Fname kiểu Variant vẫn OK, tuy nhiên tôi chỉ dùng biến kiểu Variant khi mà chưa xác định rõ được kiểu của nó, ví dụ khi cần 1 biến để split 1 chuỗi nào đó, còn khi nào đã xác định được kiểu của nó thì tôi sẽ khai báo kiểu tường minh. Nên chỗ này tôi nghĩ là nên khai báo rõ kiểu Fname là String.
- Còn về việc bớt 1 dòng lệnh khi mở WB mới thì chính xác là như vậy, có thể viết gộp lại 1 câu lệnh luôn cho gọn. Ngoài ra, để copy 1 Sheet thì cũng không cần phải Active WB nguồn, nên bạn có thể bỏ luôn câu lệnh tiếp theo là TgtWb.Activate.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom