Đi thẳng đến folder chứa dữ liệu và file chạy

[Hoàng Phi Hồng]

Nhờ anh/chị và các bạn hỗ trợ.
Mình muốn lấy dữ liệu từ nhiều File vào một File bằng code và dùng Application.GetOpenFilename để mở forder và lấy dữ liệu từ các files trong Folder.
- Nếu toàn bộ File cần lấy và File chạy code trong một Forder thì khi chạy code nó đến thẳng Forlder chứa toán bộ các dữ liệu này bằng thêm đoạn code này

FileSystem.ChDir ActiveWorkbook.Path

FileNames = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _

Title:="Get data", MultiSelect:=True)

- Tuy nhiên, nếu Forder bằng tiếng việt thì nó lỗi và không vào trực tiếp được nữa. Có cách gì để làm được nhiệm vụ này thay thế đoạn FileSystem.ChDir ActiveWorkbook.Path
Xin cảm ơn các bạn.

 

[Deleted member 1392]

Lưu ý là code nên để trong thẻ code nha bạn, nhìn rối lắm. Tôi sửa lại cho bạn, lần sau lưu ý hơn nhé.
Bạn đọc bài

Bạn cần đăng nhập để thấy link

về ShortPath và ShortFile trong FSO xem có giúp ích gì cho bạn không.

 

[Hoàng Phi Hồng]

Lưu ý là code nên để trong thẻ code nha bạn, nhìn rối lắm. Tôi sửa lại cho bạn, lần sau lưu ý hơn nhé.
Bạn đọc bài

Bạn cần đăng nhập để thấy link

về ShortPath và ShortFile trong FSO xem có giúp ích gì cho bạn không.

Cảm ơn bạn, mới vào diễn đàn nên mình chưa quen cách dùng lắm.

 

[Deleted member 1392]

@Hoàng Phi Hồng Thử đọc bài viết xem có giúp ích được gì cho bạn không, lỗi Path tiếng việt thường được giải quyết bằng ShortPath và ShortFile.

 

[xiaomi]

Mình có cái code này gần giống yêu cầu của bạn, chỉ cần chỉnh sửa một chút là thành của bạn, ở đây dùng vòng lặp for để duyệt các file trong folder nên mình nghĩ không bị ảnh hưởng bởi tên file.

Sub LayDuLieuTuCacFile()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

On Error GoTo X

Dim FileNguon As String
Dim lr, ls As Long

Dim wb_src As Workbook, wb_des As Workbook

Dim FSO As Object, ObjFile As Object
Set FSO = CreateObject("Scripting.FileSystemObject") 'Khai bao FSO

Application.FileDialog(msoFileDialogFolderPicker).Show
FileNguon = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems.Item(1) 'Chon folder chua cac file nguon bang tay, co the thay bang dia chi folder


Set wb_src = ThisWorkbook


With FSO.GetFolder(FileNguon)
      For Each ObjFile In .Files 'Vong For duyet tat ca cac file trong folder
            lr = Sheets("DATA").Cells(Rows.Count, "C").End(xlUp).Row 'Dong cuoi cung chua du lieu o cot C

            Set wb_des = Workbooks.Open(ObjFile)
            ls = Sheets("基本").Cells(Rows.Count, "H").End(xlUp).Row 'Dong cuoi cung chua du lieu o cot H

                If ls = 32 Then
'Copy du lieu tu FileNguon sang file dich theo dieu kien if

                    wb_des.Sheets("基本").Range("F4").Copy
                    wb_src.Sheets("DATA").Range("C" & lr + 1).PasteSpecial Paste:=xlPasteValues
                    wb_src.Sheets("DATA").Range("P" & lr + 1).Value = "◎"
                End If
                If ls > 32 Then
'Copy du lieu tu FileNguon sang file dich theo dieu kien if

                    wb_des.Sheets("基本").Range("F4").Copy
                    wb_src.Sheets("DATA").Range("C" & lr + 1 & ":" & "C" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("C33:C" & ls).Copy
                    wb_src.Sheets("DATA").Range("V" & lr + 1 & ":" & "V" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("G33:G" & ls).Copy
                    wb_src.Sheets("DATA").Range("Q" & lr + 1 & ":" & "Q" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("H33:H" & ls).Copy
                    wb_src.Sheets("DATA").Range("U" & lr + 1 & ":" & "U" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("I33:I" & ls).Copy
                    wb_src.Sheets("DATA").Range("S" & lr + 1 & ":" & "S" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("K33:K" & ls).Copy
                    wb_src.Sheets("DATA").Range("T" & lr + 1 & ":" & "T" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("L33:L" & ls).Copy
                    wb_src.Sheets("DATA").Range("W" & lr + 1 & ":" & "W" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("O33:O" & ls).Copy
                    wb_src.Sheets("DATA").Range("AB" & lr + 1 & ":" & "AB" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues
                    
                    wb_des.Sheets("基本").Range("J33:J" & ls).Copy
                    wb_src.Sheets("DATA").Range("K" & lr + 1 & ":" & "K" & lr + ls - 32).PasteSpecial Paste:=xlPasteValues

                    wb_src.Sheets("DATA").Range("P" & lr + 1 & ":" & "P" & lr + ls - 32).Value = "社内"
                End If
                
            wb_des.Close (False)
        
      Next
End With
Exit Sub
X:
MsgBox "Co Loi Xay Ra, Ket Qua Co The Khong Day Du"


Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[tuhocvba]

Tôi thấy mấy bài trả lời ở đây đều loanh qua loanh quanh.
-Các bạn có hiểu câu hỏi của chủ topic không?
-Các bạn có giải quyết được không?

Nếu không làm được thì im lặng. Đừng dẫn người ta đi loanh quanh rồi đâm vào bức vách.
Vấn đề của người ta là chọn select file. Thông thường khi mà select file thì máy tính sẽ trỏ tới thư mục MyDocument. Đây là chế độ mặc định.
Bây giờ bạn ấy muốn chế độ mặc định là nó trỏ về thư mục chứa file Tool.
Nhưng nếu đường link trỏ tới file tool chứa tiếng việt có dấu thì không trỏ tới được, và bị lỗi.

Cái vấn đề của chủ topic tôi cũng đã gặp.
Tôi cho dòng code vào đầu chương trình của thủ tục trỏ tới thư mục là

 On Error Resume Next

thì nó vẫn trỏ tới thư mục chứa file tool, dù thư mục này được đặt trong một thư mục có tên viết bằng tiếng việt có dấu.

Bạn cần đăng nhập để thấy link

 

[thanhphong]

Control Panel/Region/Administrative/Change System Locale, I set it to Chinese. So, Dir now works with Chinese.

Bạn thử làm tương tự xem có Việt Nam không nhé.
Nguồn:

Bạn cần đăng nhập để thấy link

 

[Euler]

#6: Cái này chắc là tùy máy tính. Máy tính của em là chỉ đi tới ổ đĩa chứa thư mục. Còn tên thư mục tiếng việt thì nó chưa vào được.
Cách xử lý này cũng tốt, ít nhất không gây ra lỗi tạo nên hoang mang cho người dùng.

#7: Cách làm này không biết thế nào nên Euler không ưu tiên, vì thấy cách giải quyết quá phiền hà, phải thiết định này nọ.

Mọi người cho ý kiến giải pháp dưới đây nhé. Euler test trên máy Euler thì nuột lắm. Win 10 + Office 365 Excel 32 bit.

Euler có file excel được để trong thư mục sau:

C:\Users\Euler\Desktop\THVBA\tiếng việt

File Excel này chứa đoạn code sau:

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

Euler chạy là nó mở luôn thư mục tiếng việt. Không lỗi lầm. Mọi người chạy thử rồi cho ý kiến nha.
Món này Euler tham khảo ở đây:

Bạn cần đăng nhập để thấy link