Question

我有一个宏可以将文件保存到“ MyDocuments”，但是我不希望用户将它与可能已经在其中的其他文件堆在一起，所以我希望将其保存到一个新文件夹中“ DriverLog”。我曾尝试放入SpecialFolders（“ MyDocuments \ DriverLog \”），但表示它不存在。

这是我的代码：

Sub SaveBook()
'----------------------------------------------------
'Save File to Hard Drive
'----------------------------------------------------
Dim sFile As String
sFile = Range("G2").Value & "_DriverLog" & ".xlsm"
ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("MyDocuments\") & sFile, FileFormat:=52

MsgBox ("This has been saved as '") & CreateObject("WScript.Shell").SpecialFolders("MyDocuments\") & sFile & ("' in your documents folder.")


End Sub

代码可以自动保存文件，没有问题...我只是无法创建新文件夹。

Answer 1

这应该为您工作。 CreateDirectory子程序是我用于此任务的常用例程。

Sub SaveBook()
'----------------------------------------------------
'Save File to Hard Drive
'----------------------------------------------------

    Dim sFile As String
    Dim sPath As String
    Dim sPS As String

    sPS = Application.PathSeparator
    sPath = Environ("UserProfile") & sPS & "Documents" & sPS & "DriverLog" & sPS
    CreateDirectory sPath
    If Len(Dir(sPath, vbDirectory)) = 0 Then Exit Sub   'Couldn't create the path due to invalid or inaccessible location
    sFile = Range("G2").Value & "_DriverLog" & ".xlsm"

    ActiveWorkbook.SaveAs Filename:=sPath & sFile, FileFormat:=52

    MsgBox ("This has been saved as '") & sPath & sFile & ("' in your documents folder.")

End Sub

Sub CreateDirectory(ByVal arg_sFolderpath As String)

    If Len(Dir(arg_sFolderpath, vbDirectory)) = 0 Then
        Dim sPS As String
        sPS = Application.PathSeparator

        Dim sBuildPath As String
        Dim vFolder As Variant
        For Each vFolder In Split(arg_sFolderpath, sPS)
            If Len(vFolder) > 0 Then
                If Len(sBuildPath) = 0 Then sBuildPath = vFolder Else sBuildPath = sBuildPath & sPS & vFolder
                If Len(Dir(sBuildPath, vbDirectory)) = 0 Then
                    On Error Resume Next
                    MkDir sBuildPath
                    On Error GoTo 0
                    If Len(Dir(sBuildPath, vbDirectory)) = 0 Then
                        MsgBox "[" & sBuildPath & "] is either invalid or unreachable.", , "Create Directory Error"
                        Exit Sub
                    End If
                End If
            End If
        Next vFolder
    End If

End Sub

Answer 2

我的是代码的简化版本。

'----------------------------------------------------
'Save File to Hard Drive
'----------------------------------------------------
Dim sFile       As String
Dim sPath       As String

sPath = "C:\Users\User\MyDocuments\DriverLog"

sFile = Range("G2").Value & "_DriverLog" & ".xlsm"

If Len(Dir(sPath, vbDirectory)) = 0 Then  'Added This line to create new folder
    MkDir (sPath)
End If


ActiveWorkbook.SaveAs Filename:=sPath & "\" & sFile


MsgBox ("This has been saved as ") & sPath & "\" & sFile

我想保存新文件并在“文档”的新文件夹中创建文件

2 个答案: