Cháu cần viết sub tạo 1 file TXT và đổi tên theo điều kiện

[1+1=2]

Cháu chào tất cả cô chú bác diển đàn Excel. Cháu cần tạo 1 file và đổi tên theo điều kiện sau. rất mong cô chú bỏ ít thời gian giúp cháu. Cháu xin cảm ơn


trong file 1.txt hoặc 2.txt để trống khồng cần nội dung gì hết

 

[Maika8008]

Cháu chào tất cả cô chú bác diển đàn Excel. Cháu cần tạo 1 file và đổi tên theo điều kiện sau. rất mong cô chú bỏ ít thời gian giúp cháu. Cháu xin cảm ơn

View attachment 241437
trong file 1.txt hoặc 2.txt để trống khồng cần nội dung gì hết

Sub CreateTextFile()
Dim fso As Object, File As Object
Dim FPath As String
Const FPath = "C:\Users\Congty\Desktop\Test\"

Set fso = CreateObject("Scripting.FileSystemObject")

    If Dir$(FPath & "1.txt") <> "" And Dir$(FPath & "2.txt") = "" Then
        fso.MoveFile FPath & "1.txt", FPath & "2.txt"
        Sheets("Data").Range("A1") = 2
    ElseIf Dir$(FPath & "1.txt") = "" And Dir$(FPath & "2.txt") <> "" Then
        fso.MoveFile FPath & "2.txt", FPath & "1.txt"
        Sheets("Data").Range("A1") = 1
    ElseIf Dir$(FPath & "1.txt") = "" And Dir$(FPath & "2.txt") = "" Then
        Set File = fso.CreateTextFile(FPath & "1.txt")
        Sheets("Data").Range("A1") = 1
        File.Close
        Set File = Nothing
    Else
        MsgBox "Ca 2 file 1.txt va 2.txt deu ton tai!"
    End If
    
    Set fso = Nothing
End Sub

 

[Kiều Mạnh]

xài Fso thì bỏ cái Dir kia được rồi

 

[Maika8008]

xài Fso thì bỏ cái Dir kia được rồi

Để tôi thử lại. Tôi mò code, hồi nãy khai báo sớm thì thuộc tính FileExists nó không chạy.

Update: Sửa như Kiều Mạnh nhắc và tiện thể sửa lại cấu trúc chứ bài #2 sai rồi

Sub CreateTextFile2()
Dim fso As Object, File As Object
Const FPath = "C:\Users\Congty\Desktop\Test\"

Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(FPath & "1.txt") And fso.FileExists(FPath & "2.txt") Then
        MsgBox "Ca 2 file 1.txt va 2.txt deu ton tai!"
    ElseIf fso.FileExists(FPath & "1.txt") And Not fso.FileExists(FPath & "2.txt") Then
        fso.MoveFile FPath & "1.txt", FPath & "2.txt"
        Sheets("Data").Range("A1") = 2
    ElseIf Not fso.FileExists(FPath & "1.txt") And fso.FileExists(FPath & "2.txt") Then
        fso.MoveFile FPath & "2.txt", FPath & "1.txt"
        Sheets("Data").Range("A1") = 1
    Else
        Set File = fso.CreateTextFile(FPath & "1.txt")
        Sheets("Data").Range("A1") = 1
        File.Close
        Set File = Nothing
    
    End If
    
    Set fso = Nothing
End Sub

 

[1+1=2]

Để tôi thử lại. Tôi mò code, hồi nãy khai báo sớm thì thuộc tính FileExists nó không chạy.

Update: Sửa như Kiều Mạnh nhắc và tiện thể sửa lại cấu trúc chứ bài #2 sai rồi

Sub CreateTextFile2()
Dim fso As Object, File As Object
Const FPath = "C:\Users\Congty\Desktop\Test\"

Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(FPath & "1.txt") And fso.FileExists(FPath & "2.txt") Then
        MsgBox "Ca 2 file 1.txt va 2.txt deu ton tai!"
    ElseIf fso.FileExists(FPath & "1.txt") And Not fso.FileExists(FPath & "2.txt") Then
        fso.MoveFile FPath & "1.txt", FPath & "2.txt"
        Sheets("Data").Range("A1") = 2
    ElseIf Not fso.FileExists(FPath & "1.txt") And fso.FileExists(FPath & "2.txt") Then
        fso.MoveFile FPath & "2.txt", FPath & "1.txt"
        Sheets("Data").Range("A1") = 1
    Else
        Set File = fso.CreateTextFile(FPath & "1.txt")
        Sheets("Data").Range("A1") = 1
        File.Close
        Set File = Nothing
   
    End If
   
    Set fso = Nothing
End Sub

chảu cảm ơn chú. Cho chảu hỏi trường hợp thu mục TXT cùng với file excel sao cháy sữa code như vầy mà nó báo lỗi
Const FPath = ThisWorkbook.Path & "\"

Bài đã được tự động gộp: 21/7/20

chảu cảm ơn chú. Cho chảu hỏi trường hợp thu mục TXT cùng với file excel sao cháy sữa code như vầy mà nó báo lỗi
Const FPath = ThisWorkbook.Path & "\"

ak cháu sữa lại code được rồi

Sub CreateTextFile2()
Dim fso As Object, File As Object, FPath As String
 FPath = ThisWorkbook.Path & "\"

Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(FPath & "1.txt") And fso.FileExists(FPath & "2.txt") Then
        MsgBox "Ca 2 file 1.txt va 2.txt deu ton tai!"
    ElseIf fso.FileExists(FPath & "1.txt") And Not fso.FileExists(FPath & "2.txt") Then
        fso.MoveFile FPath & "1.txt", FPath & "2.txt"
        Sheets("Data").Range("A1") = 2
    ElseIf Not fso.FileExists(FPath & "1.txt") And fso.FileExists(FPath & "2.txt") Then
        fso.MoveFile FPath & "2.txt", FPath & "1.txt"
        Sheets("Data").Range("A1") = 1
    Else
        Set File = fso.CreateTextFile(FPath & "1.txt")
        Sheets("Data").Range("A1") = 1
        File.Close
        Set File = Nothing
    
    End If
    
    Set fso = Nothing
End Sub

 

[Maika8008]

chảu cảm ơn chú. Cho chảu hỏi trường hợp thu mục TXT cùng với file excel sao cháy sữa code như vầy mà nó báo lỗi
Const FPath = ThisWorkbook.Path & "\"

Muốn vậy phải sửa thế này mới được:

Dim FPath as String
FPath = ThisWorkbook.Path & "\"