文件夹交互后继续运行代码

时间:2018-01-24 09:20:59

标签: excel vba excel-vba

我有一个简短的程序,在将文件上传到我们的处理工具之前重命名该文件,遗憾的是该文件位于受密码保护的.zip文件中(我们无法使用标准提取,它的公司政策我们必须使用SecureZip)所以我需要在脚本可以与之交互之前提取它。我知道如何使用vba打开文件夹,但是在关闭文件夹后如何继续执行代码?到目前为止,我有以下代码:

Sub Extract_Rename()
Dim FolderPath As String
Dim OldName As String
Dim NewName As String

OldName = "REPORTS2xxxx.SCR0400." & mGlobalDate & ".txt" 'define default file name
NewName = "123456_GR_xxxx_ALL_xxxx_modules_" & mGlobalDate & ".txt" 'define new file name
FolderPath = "C:\Users\" 'define source folder path

    Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus 'open source folder to extract the file from .zip archive

    On Error GoTo Quit

        Name "C:\Users\" & OldName As "C:\Users\" & NewName 'rename file

Quit:

End Sub

1 个答案:

答案 0 :(得分:2)

如果没有用户互动,这是不可能的。我可以想象两种可能的解决方案。

  1. 用户必须按一个按钮进行重命名,并为重命名部分调用另一个子。
  2. 我们弹出一个消息框,暂停代码,直到用户确认他解压缩文件。
  3. 以下是第二个解决方案的示例:

    Option Explicit 'see note below
    
    Public Sub Extract_Rename()
        Dim FolderPath As String
        Dim OldName As String
        Dim NewName As String
    
        OldName = "REPORTS2xxxx.SCR0400." & mGlobalDate & ".txt" 'define default file name
        NewName = "123456_GR_xxxx_ALL_xxxx_modules_" & mGlobalDate & ".txt" 'define new file name
        FolderPath = "C:\Users\" 'define source folder path
    
        Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus 'open source folder to extract the file from .zip archive
    
        'this msgbox stops the code until the user presses OK
        If Not MsgBox("Please unzip the file, when finished press OK to proceed.", _
          vbOKCancel + vbExclamation) = vbOK Then GoTo Quit
    
        On Error GoTo Quit
        Name "C:\Users\" & OldName As "C:\Users\" & NewName 'rename file
    
    Quit:
    
    End Sub
    

    注意:您应该使用Option Explicit。您的变量Foldername未声明,但您可能需要使用FolderPath。如果您使用Option Explicit,这些问题就不会再发生了。