Lỗi Input past end of file (4 người xem)

Quang_Hải · 18/8/14

Các anh chị xem giúp tại sao code này bị lỗi Input past end of file
Một số folder thì lấy được file, 1 số folder thì bị lỗi dù trong folder có chứa file. +-+-+-+

Không biết có phải vì sai câu lệnh Scomm

PHP:

Sub GetFiles()
Dim sComm As String, tmpFile, path, Res, i
With Application.FileDialog(msoFileDialogFolderPicker)
   If .Show Then
      path = .SelectedItems(1)
      If Right(path, 1) <> "\" Then path = path & "\"
      With CreateObject("Scripting.FileSystemObject")
         tmpFile = "D:\" & .GetTempName
         sComm = "DIR " & path & "/A-D/B/C/D/O/N/S > " & tmpFile
         CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True
         Res = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf)
         Kill tmpFile
      End With
      MsgBox UBound(Res)
   End If
End With
End Sub

Quang_Hải · 18/8/14

Alo Alo
Vừa phát hiện 1 điều vô cùng kỳ cục là lạ
Khi chọn bất kỳ 1 thư mục nào mà chính nó hoặc thư mục mẹ, hoặc thư mục ông bà của nó có chứa 1 khoảng trắng thì code không chạy
Ví dụ ta có C:\Program Files\A\B\C thì khi ta chỉ vào thư mục nào code cũng không chạy, trừ khi ta chỉ vào ổ đĩa C.
Anh chị nào có biết nguyên nhân và cách khắc phục không?

PHP:

Sub GetFiles()
Dim sComm As String, tmpFile As String, path As String, Res
With Application.FileDialog(msoFileDialogFolderPicker)
   If .Show Then
      path = .SelectedItems(1)
      If Right(path, 1) <> "\" Then path = path & "\"
      With CreateObject("Scripting.FileSystemObject")
         tmpFile = "D:\tmp.txt"
         .CreateTextFile tmpFile, True, True
         sComm = "DIR " & path & "/A-D/B/C/D/O/N/S > " & tmpFile
         CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True
         Res = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf)
         Kill tmpFile
      End With
      MsgBox UBound(Res)
   End If
End With
End Sub

siwtom · 18/8/14

quanghai1969 đã viết:
Alo Alo
Vừa phát hiện 1 điều vô cùng kỳ cục là lạ
Khi chọn bất kỳ 1 thư mục nào mà chính nó hoặc thư mục mẹ, hoặc thư mục ông bà của nó có chứa 1 khoảng trắng thì code không chạy
Ví dụ ta có C:\Program Files\A\B\C thì khi ta chỉ vào thư mục nào code cũng không chạy, trừ khi ta chỉ vào ổ đĩa C.
Anh chị nào có biết nguyên nhân và cách khắc phục không?

PHP:

Sub GetFiles() Dim sComm As String, tmpFile As String, path As String, Res With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then path = .SelectedItems(1) If Right(path, 1) <> "\" Then path = path & "\" With CreateObject("Scripting.FileSystemObject") tmpFile = "D:\tmp.txt" .CreateTextFile tmpFile, True, True sComm = "DIR " & path & "/A-D/B/C/D/O/N/S > " & tmpFile CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True Res = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf) Kill tmpFile End With MsgBox UBound(Res) End If End With End Sub

Cho đường dẫn vào cặp ngoặc ""
Tức

Mã:

path = """" & .SelectedItems(1) & """"

Ở cửa sổ dòng lệnh (command line) tương tự. Ta không thể gõ:

Mã:

dir C:\Program Files

mà phải gõ

Mã:

dir "C:\Program Files"

--------------
Nếu vì một "cái gì đấy" mà tập tin tmpFile bị rỗng thì sẽ có lỗi như thế.

Tạo lỗi: phải chuột trên thư mục D:\ nà chọn New --> Text File --> đổi tên thành hichic.txt.
Rõ ràng tập tin hichic.txt rỗng. Bây giờ chạy code

Mã:

Sub he()
Dim s As String
    s = CreateObject("Scripting.FileSystemObject").OpenTextFile("d:\hichic.txt", 1).ReadAll
End Sub

thì có lỗi "kia". Nhưng nếu hichic.txt có ít nhất 1 ký tự dấu cách chẳng hạn thì không còn lỗi.

Khi nào có lỗi tmpFile rỗng. Tôi không biết có tất cả những trường hợp nào nhưng chắc chắn tôi tin có 1 trường hợp. Vd. thư mục xyz có 1000 thư mục con và 1000 tập tin, và không thể truy cập xyz (access denied) - trên XP của tôi thì click "System Volume Information" = access denied. Nếu bạn chọn thư mục xyz thì tmpFile rỗng.

ndu96081631 · 18/8/14

quanghai1969 đã viết:
Alo Alo
Vừa phát hiện 1 điều vô cùng kỳ cục là lạ
Khi chọn bất kỳ 1 thư mục nào mà chính nó hoặc thư mục mẹ, hoặc thư mục ông bà của nó có chứa 1 khoảng trắng thì code không chạy

Thế sao không xem lại hàm người ta viết từ trước để nghiên cứu:

Mã:

Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
                          ByVal Search As String, ByVal InSub As Boolean)
  'ListType = True: Get Files list
  'ListType = False: Get Folders list
  Dim sComm As String, tmp As String, str As String, tmpFile, Arr
  On Error Resume Next
  If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
  [COLOR=#ff0000]str = """" & RootFolder & Search & """"[/COLOR]
  
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D-S" & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then
        If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)
        FilesFoldersList = Split(tmp, vbCrLf)
      End If
      .Close
    End With
  End With
  Kill tmpFile
End Function

Quang_Hải · 18/8/14

ndu96081631 đã viết:
Thế sao không xem lại hàm người ta viết từ trước để nghiên cứu:

Nói thiệt cho anh biết là từ trước tới giờ xài ké hàm này của anh, nhưng có hiểu gì đâu mà nghiên mà cứu. Nay em liều mạng mổ nó ra thì mới té ra nhiều cái cần học. Trước giờ thấy mấy cặp nháy đó đôi lúc cũng thắc mắc nhưng chưa đủ kiến thức thì có hỏi cũng phí. Giờ thì hơi thấm chút ít rồi.

siwtom đã viết:
Cho đường dẫn vào cặp ngoặc ""
Tức

Mã:

path = """" & .SelectedItems(1) & """"

Ở cửa sổ dòng lệnh (command line) tương tự. Ta không thể gõ:

Mã:

dir C:\Program Files

mà phải gõ

Mã:

dir "C:\Program Files"

--------------
Nếu vì một "cái gì đấy" mà tập tin tmpFile bị rỗng thì sẽ có lỗi như thế.
Tạo lỗi: phải chuột trên thư mục D:\ nà chọn New --> Text File --> đổi tên thành hichic.txt.
Rõ ràng tập tin hichic.txt rỗng. Bây giờ chạy code

Mã:

Sub he() Dim s As String s = CreateObject("Scripting.FileSystemObject").OpenTextFile("d:\hichic.txt", 1).ReadAll End Sub

thì có lỗi "kia". Nhưng nếu hichic.txt có ít nhất 1 ký tự dấu cách chẳng hạn thì không còn lỗi.
Khi nào có lỗi tmpFile rỗng. Tôi không biết có tất cả những trường hợp nào nhưng chắc chắn tôi tin có 1 trường hợp. Vd. thư mục xyz có 1000 thư mục con và 1000 tập tin, và không thể truy cập xyz (access denied) - trên XP của tôi thì click "System Volume Information" = access denied. Nếu bạn chọn thư mục xyz thì tmpFile rỗng.

Bài giải của anh làm cho em sáng ra được chút nữa.

................................

Còn 2 vấn đề liên quan, mong các anh giải thích giúp:

1. Không thể lấy được tiếng việt có dấu, trong khi dùng FSO thì có dấu tiếng việt
2. Mình có thể nào chỉ định đuôi file hay không? Chẳng hạn như (*.xls* và *.doc*). Ý em là cùng 1 lúc mình yêu cầu tới 2 định dạng. Hiện tại em phải dùng vòng lặp để chạy riêng từng định dạng

siwtom · 18/8/14

quanghai1969 đã viết:
Nói thiệt cho anh biết là từ trước tới giờ xài ké hàm này của anh, nhưng có hiểu gì đâu mà nghiên mà cứu. Nay em liều mạng mổ nó ra thì mới té ra nhiều cái cần học. Trước giờ thấy mấy cặp nháy đó đôi lúc cũng thắc mắc nhưng chưa đủ kiến thức thì có hỏi cũng phí. Giờ thì hơi thấm chút ít rồi.

Bài giải của anh làm cho em sáng ra được chút nữa.

................................

Còn 2 vấn đề liên quan, mong các anh giải thích giúp:

1. Không thể lấy được tiếng việt có dấu, trong khi dùng FSO thì có dấu tiếng việt
2. Mình có thể nào chỉ định đuôi file hay không? Chẳng hạn như (*.xls* và *.doc*). Ý em là cùng 1 lúc mình yêu cầu tới 2 định dạng. Hiện tại em phải dùng vòng lặp để chạy riêng từng định dạng

Đơn giản là do ở dòng lệnh không thể dùng được đường dẫn có dấu cách. Vì thế ở dòng lệnh phải cho đường dẫn vào cặp ngoặc "". Code của bạn kích hoạt dòng lệnh nên đương nhiên phải thêm cặp ngoặc "". Nguyên do của "" là thế.
Bạn luôn phải cho vào cặp ngoặc "" để lường được đường dẫn có dấu cách. Đường dẫn có dấu cách mà không có cặp ngoặc thì tèo trong khi đường dẫn không có dấu cách mà vẫn cho vào cặp ngoặc "" thì lại chả sao.
-----------------
Học trước quên sau, chán.

Tôi đã nói hơn 2 năm trước ở đây

http://www.giaiphapexcel.com/forum/...-1-folder-vào-Folder-khác&p=414950#post414950

ndu96081631 · 19/8/14

quanghai1969 đã viết:
1. Không thể lấy được tiếng việt có dấu, trong khi dùng FSO thì có dấu tiếng việt

Cũng hàm đó:

Mã:

Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
                          ByVal Search As String, ByVal InSub As Boolean)
  'ListType = True: Get Files list
  'ListType = False: Get Folders list
  Dim sComm As String, tmp As String, str As String, tmpFile, Arr
  On Error Resume Next
  If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
  str = """" & RootFolder & Search & """"
  
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D-S" & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd [B][COLOR=#ff0000]/u[/COLOR][/B] /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , [B][COLOR=#ff0000]-2[/COLOR][/B])
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then
        If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)
        FilesFoldersList = Split(tmp, vbCrLf)
      End If
      .Close
    End With
  End With
  Kill tmpFile
End Function

Chỗ màu đỏ để xử lý tiếng Việt Unicode
------------------------------------

quanghai1969 đã viết:
2. Mình có thể nào chỉ định đuôi file hay không? Chẳng hạn như (*.xls* và *.doc*). Ý em là cùng 1 lúc mình yêu cầu tới 2 định dạng. Hiện tại em phải dùng vòng lặp để chạy riêng từng định dạng

Thật ra DOS làm được. Xem câu lệnh này khi gõ trong lệnh DOS:
DIR D:\Excel\*.xls D:\Excel\*.doc /ON /B /A-D >C:\tmpFile.txt
Lấy 2 định dạng xls và doc ===> Tự suy luận nhé!

Quang_Hải · 19/8/14

siwtom đã viết:
Học trước quên sau, chán.

Tôi đã nói hơn 2 năm trước ở đây

http://www.giaiphapexcel.com/forum/...-1-folder-vào-Folder-khác&p=414950#post414950

Tội em quá mà. 2 năm trước em mới bập bẹ vba thì đọc có hiểu được tí nào đâu.

ndu96081631 đã viết:
Cũng hàm đó:
Thật ra DOS làm được. Xem câu lệnh này khi gõ trong lệnh DOS:
DIR D:\Excel\*.xls D:\Excel\*.doc /ON /B /A-D >C:\tmpFile.txt
Lấy 2 định dạng xls và doc ===> Tự suy luận nhé!

Chắc chắn là em sẽ suy luận được mà. Chỉ cần nhìn thấy là em bắt chước nhanh lắm.

siwtom · 19/8/14

quanghai1969 đã viết:
Tội em quá mà. 2 năm trước em mới bập bẹ vba thì đọc có hiểu được tí nào đâu.

Êêê, vụng chèo khéo chống. Code có thể không hiểu nhưng tôi viết rõ mồn một

Ta chỉ cần trang điểm chút chút cho nó lộng lẫy hơn, tức hỗ trợ tiếng Việt. Ai thích tên thư mục, tên tập tin bằng tiếng Việt xin cứ mạnh dạn

...
"cmd /U

Chỗ /U có tô đỏ đàng hoàng

Quang_Hải · 19/8/14

Mình kết hợp võ công thâm hậu của Triển Chiêu và Bạch Ngọc Đường lại và cho ra 1 chiêu thức tạm gọi tên là Loạn Cào Cào. Coi như cũng là 1 thành quả.

PHP:

Function GetAllFile(ByVal StrFolder As String, insub As Boolean)
On Error Resume Next
Dim sComm As String, tmpFile As String, Res
   With CreateObject("Scripting.FileSystemObject")
      tmpFile = "D:\" & .GetTempName
      sComm = "DIR " & StrFolder & " /B/O " _
      & IIf(insub, "/S", vbNullString) & " > " & tmpFile
      CreateObject("Wscript.Shell").Run "cmd /u/c " & sComm, 0, 1
      GetAllFile = Split(.OpenTextFile(tmpFile, 1, , -1).ReadAll, vbCrLf)
      Kill tmpFile
   End With
End Function

Nếu như Insub= False sẽ trả về tên file không kèm đường dẫn nên tạm thời mình thêm cái vòng lặp For Next để xử lý.
Không biết là có cách nào hay hơn không, và cách mình chỉ định đuôi file cần tìm như thế này có hợp lý chưa?
Nếu có phương án khác, các anh vui lòng góp ý giúp.

PHP:

Sub Main()
On Error Resume Next
Dim i As Long, path As String, Sarr, Res(), insub As Boolean, tam As String
insub = 1
With Application.FileDialog(msoFileDialogFolderPicker)
   If .Show Then
      path = .SelectedItems(1)
      If Right(path, 1) <> "\" Then path = path & "\"
      tam = path
      path = """" & path & """"
      path = path & "*.xls " & path & "*.doc " & path & "*.pdf "
      Sarr = GetAllFile(path, insub)
      ReDim Res(1 To UBound(Sarr), 1 To 1)
      For i = LBound(Sarr) To UBound(Sarr) - 1
         If Not insub Then
            Res(i + 1, 1) = tam & Sarr(i)
         Else
            Res(i + 1, 1) = Sarr(i)
         End If
      Next
      [A1].Resize(i) = Res
   End If
End With
End Sub

Kiều Mạnh · 19/8/14

quanghai1969 đã viết:
Mình kết hợp võ công thâm hậu của Triển Chiêu và Bạch Ngọc Đường lại và cho ra 1 chiêu thức tạm gọi tên là Loạn Cào Cào. Coi như cũng là 1 thành quả.

PHP:

Function GetAllFile(ByVal StrFolder As String, insub As Boolean) On Error Resume Next Dim sComm As String, tmpFile As String, Res With CreateObject("Scripting.FileSystemObject") tmpFile = "D:\" & .GetTempName sComm = "DIR " & StrFolder & " /B/O " _ & IIf(insub, "/S", vbNullString) & " > " & tmpFile CreateObject("Wscript.Shell").Run "cmd /u/c " & sComm, 0, 1 GetAllFile = Split(.OpenTextFile(tmpFile, 1, , -1).ReadAll, vbCrLf) Kill tmpFile End With End Function

Nếu như Insub= False sẽ trả về tên file không kèm đường dẫn nên tạm thời mình thêm cái vòng lặp For Next để xử lý.
Không biết là có cách nào hay hơn không, và cách mình chỉ định đuôi file cần tìm như thế này có hợp lý chưa?
Nếu có phương án khác, các anh vui lòng góp ý giúp.

PHP:

Sub Main() On Error Resume Next Dim i As Long, path As String, Sarr, Res(), insub As Boolean, tam As String insub = 1 With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then path = .SelectedItems(1) If Right(path, 1) <> "\" Then path = path & "\" tam = path path = """" & path & """" path = path & "*.xls " & path & "*.doc " & path & "*.pdf " Sarr = GetAllFile(path, insub) ReDim Res(1 To UBound(Sarr), 1 To 1) For i = LBound(Sarr) To UBound(Sarr) - 1 If Not insub Then Res(i + 1, 1) = tam & Sarr(i) Else Res(i + 1, 1) = Sarr(i) End If Next [A1].Resize(i) = Res End If End With End Sub

Em test thấy tốc độ cực nhanh và lấy được cả file tiếng việt có dấu và không dấu chơi được láng. ..
nhưng phát sinh một cái khi kích đúp chuột vào mở với File .doc hay pdf thì lỗi font...kiểu này phải viết thêm một sub Open with file nọ file kia nữa thì hoàn hảo đó anh

Quang_Hải · 19/8/14

kieu manh đã viết:
Em test thấy tốc độ cực nhanh và lấy được cả file tiếng việt có dấu và không dấu chơi được láng. ..
nhưng phát sinh một cái khi kích đúp chuột vào mở với File .doc hay pdf thì lỗi font...kiểu này phải viết thêm một sub Open with file nọ file kia nữa thì hoàn hảo đó anh

Đang trên nền excel mà mở thứ khác sao được. Phải mở bằng cách khác.

ndu96081631 · 19/8/14

quanghai1969 đã viết:
Nếu như Insub= False sẽ trả về tên file không kèm đường dẫn nên tạm thời mình thêm cái vòng lặp For Next để xử lý.

Code hoàn chỉnh ngay ở trên sao không chịu nhìn vậy trời:

Mã:

Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
                          ByVal Search As String, ByVal InSub As Boolean)
  'ListType = True: Get Files list
  'ListType = False: Get Folders list
  Dim sComm As String, tmp As String, str As String, tmpFile, Arr
  On Error Resume Next
  If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
  str = """" & RootFolder & Search & """"
  
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D-S" & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then
        [COLOR=#ff0000]If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)[/COLOR]
        FilesFoldersList = Split(tmp, vbCrLf)
      End If
      .Close
    End With
  End With
  Kill tmpFile
End Function

Xử lý từ trong text, chẳng có vòng lập nào cả

Quang_Hải · 19/8/14

ndu96081631 đã viết:
Code hoàn chỉnh ngay ở trên sao không chịu nhìn vậy trời:

Xử lý từ trong text, chẳng có vòng lập nào cả

Đúng là học 1 tháng không bằng hành 1 ngày.
Nếu không cày và thắc mắc thì anh cũng đâu có nói cái dòng đó là nó đó.

ndu96081631 · 19/8/14

kieu manh đã viết:
nhưng phát sinh một cái khi kích đúp chuột vào mở với File .doc hay pdf thì lỗi font

Cái này tôi không hiểu! Kích đúp chuột vào đâu? Lỗi font nghĩa là sao?

Quang_Hải · 19/8/14

ndu96081631 đã viết:
Cái này tôi không hiểu! Kích đúp chuột vào đâu? Lỗi font nghĩa là sao?

Ah vụ này thì em hiểu, hơi cá nhân 1 chút. Vì KieuManh ở có nhắn tin hỏi về sự kiện DoubleClick vào tên file để mở file sau khi liệt kê ra sheet. Vụ này em sẽ xử lý riêng để khỏi ảnh hưởng topic

Lỗi Input past end of file (4 người xem)

Người dùng đang xem chủ đề này

Quang_Hải

Thành viên gạo cội

Quang_Hải

Thành viên gạo cội

siwtom

Thành viên gắn bó

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

siwtom

Thành viên gắn bó

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

siwtom

Thành viên gắn bó

Quang_Hải

Thành viên gạo cội

Kiều Mạnh

I don't program, I beat code into submission!!!

Quang_Hải

Thành viên gạo cội

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian