Lỗi Error 53 khi chạy đoạn code (3 người xem)

[nhatruông30]

Chào mọi người,

Mình có nhiều file txt có nội dung tương tự nhau. Mỗi file txt có 3 cột. Mình muốn chuyển cột ở giữa của tất cả các file txt vào nhiều cột khác nhau trong cùng 1 sheet của excel.

Mình tìm được đoạn code trên mạng nhưng khi chạy thì nó báo lỗi 53. Xin nhờ mọi người giúp đỡ dùm. File txt trong file đính kèm. Cám ơn mọi người nhiều.

Đoạn code của mình là:

Sub test()
    Dim myDir As String, fn As String
    Dim txt As String, x, i As Long, t As Long
    Const delim As String = vbTab
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            myDir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
        If FileLen(fn) Then
            t = t + 1
            txt = CreateObject("Scripting.FileSystemObject") _
            .OpenTextFile(myDir & "\" & fn).ReadAll
            x = Split(txt, vbCrLf)
            For i = 0 To UBound(x)
                If x(i) Like "*" & delim & "*" Then
                    x(i) = Split(x(i), delim)(1)
                End If
            Next
            With Sheets(1).Cells(1, t)
                .Value = fn
                With .Offset(1).Resize(UBound(x) + 1)
                    .NumberFormat = "@"
                    .Value = Application.Transpose(x)
                End With
            End With
        End If
        fn = Dir
    Loop
End Sub

 

[siwtom]

Chào mọi người,

Mình có nhiều file txt có nội dung tương tự nhau. Mỗi file txt có 3 cột. Mình muốn chuyển cột ở giữa của tất cả các file txt vào nhiều cột khác nhau trong cùng 1 sheet của excel.

Mình tìm được đoạn code trên mạng nhưng khi chạy thì nó báo lỗi 53. Xin nhờ mọi người giúp đỡ dùm. File txt trong file đính kèm. Cám ơn mọi người nhiều.

Đoạn code của mình là:

Sub test()
    Dim myDir As String, fn As String
    Dim txt As String, x, i As Long, t As Long
    Const delim As String = vbTab
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            myDir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
        If FileLen(fn) Then
            t = t + 1
            txt = CreateObject("Scripting.FileSystemObject") _
            .OpenTextFile(myDir & "\" & fn).ReadAll
            x = Split(txt, vbCrLf)
            For i = 0 To UBound(x)
                If x(i) Like "*" & delim & "*" Then
                    x(i) = Split(x(i), delim)(1)
                End If
            Next
            With Sheets(1).Cells(1, t)
                .Value = fn
                With .Offset(1).Resize(UBound(x) + 1)
                    .NumberFormat = "@"
                    .Value = Application.Transpose(x)
                End With
            End With
        End If
        fn = Dir
    Loop
End Sub

Thay

Do While fn <> ""
        If FileLen([B][COLOR=#ff0000]fn[/COLOR][/B]) Then

bằng

Do While fn <> ""
        If FileLen([B][COLOR=#0000ff]myDir & "\" & fn[/COLOR][/B]) Then

Tức thay chỗ đỏ đỏ thành xanh xanh

 

[nhatruông30]

cám ơn bạn nhiều lắm, mình sửa lại giống bạn nói là được rồi. Cám ơn nhiều.

 

[nhatruông30]

mà bạn ơi cho mình hỏi thêm, cái cột số liệu trong excel là định dạng text, có cách nào để chuyển mấy cột đó qua định dạng number không bạn. Vì mình sẽ dùng những số này để tính toán tiếp nhưng không tính được vì đang ở định dạng text. Cám ơn bạn nhiều

 

[Quang_Hải]

mà bạn ơi cho mình hỏi thêm, cái cột số liệu trong excel là định dạng text, có cách nào để chuyển mấy cột đó qua định dạng number không bạn. Vì mình sẽ dùng những số này để tính toán tiếp nhưng không tính được vì đang ở định dạng text. Cám ơn bạn nhiều

Bạn thử xoá dòng này coi sao

.NumberFormat = "@"

 

[thuykx]

Option Explicit
Private Declare PtrSafe Function RegOpenKeyA Lib "advapi64.dll" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi64.dll" (ByVal hKey As Long) As Long
Private Declare PtrSafe Function RegSetValueExA Lib "advapi64.dll" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByVal dwType As Long, ByVal sValue As String, ByVal dwSize As Long) As Long
Private Declare PtrSafe Function RegCreateKeyA Lib "advapi64.dll" (ByVal hKey As Long, ByVal sSubKey As String, ByRef hkeyResult As Long) As Long
Private Declare PtrSafe Function RegQueryValueExA Lib "advapi64.dll" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As Long
Public Const regRootKey = "hkey_current_user"
Public Const regInstPath = "software\vnTools"
Public Const CtrlPanelPath = "Control Panel\International"
Public RegDateInts As Variant
Public regPathInstalled As String
Public regDfaultCharset As String
Public Sub RegisterInit()
regPathInstalled = GetRegistry(regRootKey, regInstPath, "AppPathInst")
If regPathInstalled = "Not Found" Then
Call WriteRegistry(regRootKey, regInstPath, "AppPathInst", ThisWorkbook.path)
regPathInstalled = GetRegistry(regRootKey, regInstPath, "AppPathInst")
Else
If regPathInstalled <> ThisWorkbook.path Then
Call WriteRegistry(regRootKey, regInstPath, "AppPathInst", ThisWorkbook.path)
regPathInstalled = GetRegistry(regRootKey, regInstPath, "AppPathInst")
End If
End If
RegDateInts = GetRegistry(regRootKey, regInstPath, "dAppInst")
If RegDateInts = "Not Found" Then
Call WriteRegistry(regRootKey, regInstPath, "dAppInst", Now())
RegDateInts = GetRegistry(regRootKey, regInstPath, "dAppInst")
End If
regDfaultCharset = GetRegistry(regRootKey, regInstPath, "dfaultChar")
If regDfaultCharset = "uniBase" Or regDfaultCharset = "vniBase" Or regDfaultCharset = "abcBase" Then
Else
Call WriteRegistry(regRootKey, regInstPath, "dfaultChar", "uniBase")
regDfaultCharset = GetRegistry(regRootKey, regInstPath, "dfaultChar")
End If
End Sub
Public Function GetRegistry(ByVal Key As String, ByVal path As String, ByVal ValueName As String)
Dim hKey As Long, lValueType As Long, sResult As String, lResultLen As Long, ResultLen As Long, x, TheKey As Long
TheKey = &H80000001
If RegOpenKeyA(TheKey, path, hKey) <> 0 Then x = RegCreateKeyA(TheKey, path, hKey)
sResult = Space(100)
lResultLen = 100
x = RegQueryValueExA(hKey, ValueName, 0, lValueType, sResult, lResultLen)
Select Case x
Case 0: GetRegistry = Left(sResult, lResultLen - 1)
Case Else: GetRegistry = "Not Found"
End Select
RegCloseKey hKey
End Function
Public Function WriteRegistry(ByVal Key As String, ByVal path As String, ByVal Entry As String, ByVal Value As String)
Dim hKey As Long, lValueType As Long, sResult As String, lResultLen As Long, TheKey, x
TheKey = &H80000001
If RegOpenKeyA(TheKey, path, hKey) <> 0 Then x = RegCreateKeyA(TheKey, path, hKey)
If Len(Value) > 0 Then
x = RegSetValueExA(hKey, Entry, 0, 1, Value, Len(Value) + 1)
Else
x = 1
End If
If x = 0 Then WriteRegistry = True Else WriteRegistry = False
End Function

Mình dùng vntool nhưng nó cứ báo lỗi not found advapi64 là sao nhỉ ? Mọi người chỉnh giúp mình với

 

[AutoReply]

trên trang MSDN tôi thấy người ta khai báo thư viện "advapire32.dll" mà , sao code lại khai báo "advapi64.dll" vậy ? thử sửa lại thành "advapi32.dll" hết các chỗ ở trên xem sao ?

 

[thuykx]

mình dùng microsof 64 nên chỉnh lại "advapire64.dll" nếu ddeer32 thì nó k dùng được