Code copy File từ thư mục này sang thư mục khác, sau đó mở file có pass ... (2 người xem)

LienDong đã viết:

Em nhờ anh/chị viết code như sau”
Bài này em không biết Record Macro sao, nên nhờ các chị giúp
1/Mở thư mục C:\ThuVien1\Van\Bai1
2/Chọn file : Bai1, copy
3/ Mở thư mục C:\TongHop
4/ Paste Bai1 vào thư mục này
5/trong thư mục C:\TongHop nếu đã có file Bai1, thì đồng ý paste đè lên
6/Sau đó mở file Bai1, trong Thư mục C:\TongHop\Bai1
7/ file Bai1 có pass open là “123”
Em cảm ơn!

Nhấp chuột vào đây để mở rộng...

LienDong đã viết:

Xin giúp em bài này

Nhấp chuột vào đây để mở rộng...

Option Explicit

Sub CopyFile_ToTongHop()

    Dim fd As FileDialog
    Dim SourceFile As String
    Dim DestFolder As String
    Dim DestFile As String
    Dim FileName As String
    Dim wb As Workbook
    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

    On Error GoTo ErrHandle

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    DestFolder = "C:\TongHop\"

    If Not FSO.FolderExists(DestFolder) Then
        FSO.CreateFolder DestFolder
    End If
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "Ch?n File"
        .InitialFileName = "C:\"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo ExitHere
        SourceFile = .SelectedItems(1)
    End With
    FileName = FSO.GetFileName(SourceFile)
    DestFile = DestFolder & FileName
    If Dir(DestFile) <> "" Then
        If MsgBox("File '" & FileName & "' dã t?n t?i." & vbCrLf & _
                  "B?n có mu?n ghi dè không?", _
                  vbYesNo + vbQuestion) = vbNo Then
            GoTo ExitHere
       End If
       For Each wb In Workbooks
            If StrComp(wb.FullName, DestFile, vbTextCompare) = 0 Then
                If MsgBox("File dang du?c m?." & vbCrLf & _
                          "Ðóng file d? ghi dè?", _
                          vbYesNo + vbQuestion) = vbNo Then
                    GoTo ExitHere
                End If
                wb.Close SaveChanges:=False
                Exit For
            End If
        Next wb
        Kill DestFile
    End If

    FSO.CopyFile SourceFile, DestFile, True
            
    Workbooks.Open FileName:=DestFile   ', Password:="123"
    MsgBox "Hoàn thành.", vbInformation

ExitHere:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Set FSO = Nothing
    Exit Sub
ErrHandle:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical
End Sub

befaint đã viết:

Ủa, người ta có cho biết file Bai1 là file PDF, hay file Docx hay file Zip gì đâu. Tài thật.

Nhấp chuột vào đây để mở rộng...

LienDong đã viết:

Xin giúp em bài này

Nhấp chuột vào đây để mở rộng...

#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" ( _
        ByVal hwnd As LongPtr, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" ( _
        ByVal hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long
#End If
Public Sub OpenAnyFile(ByVal FilePath As String)

    ShellExecute 0, "open", FilePath, vbNullString, vbNullString, 1

End Sub

         Workbooks.Open FileName:=DestFile, Password:="123"

    If MsgBox("B?n có mu?n m? file v?a copy không?", _
          vbYesNo + vbQuestion) = vbYes Then
         OpenAnyFile DestFile
    End If

HUONGHCKT đã viết:

Cảm ơn anh @befaint đã xem bài và chỉ ra chỗ còn thiếu sót. Thực tình mà nói, tôi chả có hiểu biết gì về API và cũng chả có nhiều kinh nghiệm gì. Lên diễn đàn để học và thể dục não là chính , chính vì vậy tôi thấy chỗ nào mình có thể giúp được thì giúp thôi (cũng nhờ ChatGPT hỗ trợ-như đã trình bày), tuy có thể chưa đạt được kết quả mong muốn. Và tôi cũng đã nói "Trong khi chờ các giải pháp khác hãy thử xem" và "Hy vọng giúp được bạn" là vì thế.
Không phải bài này mà rất nhiều bài khác làm tôi cứ băn khoăn: Tại sao anh biết mà không ra tay giúp đỡ nhỉ? Với kiến thức của anh, tôi và rất nhiều người tin rằng anh giải quyết bài này ngon ơ, trong vòng 1 nốt nhạc, cũng như cái tool gì (hình như là phần mềm tải hóa đơn gốc từ TCT) mà anh là tác giả và đang quảng cáo . Xin trích dẫn câu anh viết "Khi mà tất cả các loại tun, áp, phần mềm các kiểu không tải được, lỗi các kiểu thì phần mềm ExTools vẫn tải mượt mà, siêu tốc nhé."

Gửi bạn chủ thớt:
Nên rút kinh nghiệm lần sau: Khi gửi yêu cầu nên nó rõ cho biết file Bai1 là file PDF, hay file Docx hay file Zip để tránh hỏi đi hỏi lại.
Còn đây là đoạn code VBA (do ChatGPT viết) Bạn hãy cho nó vào 1 module chuẩn nhé.

Mã: Sao chép.

#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" ( _
        ByVal hwnd As LongPtr, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" ( _
        ByVal hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long
#End If
Public Sub OpenAnyFile(ByVal FilePath As String)

    ShellExecute 0, "open", FilePath, vbNullString, vbNullString, 1

End Sub

Trong Module1 (sub CopyFile_ToTongHop) bạn thay dòng

Mã: Sao chép.

         Workbooks.Open FileName:=DestFile, Password:="123"

Thành

Mã: Sao chép.

    If MsgBox("B?n có mu?n m? file v?a copy không?", _
          vbYesNo + vbQuestion) = vbYes Then
         OpenAnyFile DestFile
    End If

và chạy thử.
Hy vọng giúp được bạn.

Nhấp chuột vào đây để mở rộng...