Question

在文档中我有一个按钮来执行另存为，此函数采用路径并根据单元格和日期创建文件名。这一直工作正常，直到路径出现有一段时间，它将正确定位路径，但不再填写文件名。

Sub SaveWorkbookAsNewFile()
    Dim NewFileType As String
    Dim NewFile As String
    Dim newfilename As String
    Dim cellname As String
    Dim monthnum As String
    Dim monthtxt As String
    Dim daynum As String
    Dim yearnum As String
    Dim yeartxt As String
    Dim SaveArea As String
    Dim q As Long

    If Worksheets.Count <= 6 Then MsgBox "You must run the report before saving it.", vbInformation, "Save Error": End

    SaveArea = Sheet1.Range("K12")
    cellname = Sheet1.Range("K20")

    '********************************************************************
    Dim objFSO As Object, objFolder As Object, objSubFolder As Object
    Dim varDirectory As Variant
    Dim flag As Boolean
    Dim strDirectory As String, goodfolder As String
    Dim NumMonth As Integer

    NumMonth = 0
    q = 0
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(SaveArea)

    NumMonth = Month(Date)

    For Each objSubFolder In objFolder.subfolders

        If InStr(1, UCase(objSubFolder.Name), UCase(MonthName(NumMonth, True)), vbTextCompare) > 1 Then goodfolder = objSubFolder.Name: Exit For

    Next objSubFolder

    If Not goodfolder = "" Then SaveArea = SaveArea & goodfolder & "\"


    '********************************************************************

    monthnum = Month(Date)
    monthtxt = UCase(MonthName(monthnum, True))
    daynum = Day(Date)
    yearnum = Year(Date)
    yeartxt = Right(yearnum, 2)

    newfilename = cellname & "-" & monthtxt & "-" & daynum & "-" & yeartxt

    Application.ScreenUpdating = False    ' Prevents screen refreshing.

    NewFileType = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm," & _
               "All files (*.*), *.*"

    NewFile = Application.GetSaveAsFilename( _
        InitialFileName:=SaveArea & newfilename, _
        fileFilter:=NewFileType)

    If NewFile <> "" And NewFile <> "False" Then
        ActiveWorkbook.SaveAs FileName:=NewFile, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
            CreateBackup:=False, _
            ConflictResolution:=xlUserResolution
    End If

    Application.ScreenUpdating = True
End Sub

工作路径（SaveArea）如下：\\TestServer\Test\Test\Standards\Test\Test 1\

损坏的路径（SaveArea）如下：\\TestServer\Test\Test\Standards\Test\Test. 1\

两者都会显示“另存为”对话框，但带有句点的路径不会填充文件名。当路径包含句点时，有没有办法使这个工作？

编辑：我发现了类似的帖子here，但它没有解决问题的解决方案。

Answer 1

要使其工作，请将文件扩展名添加到InitialFileName参数，如下所示：

NewFile = Application.GetSaveAsFilename( _
    InitialFileName:=SaveArea & newfilename & ".xlsm", _
    fileFilter:=NewFileType)

Excel InitialFileName不使用句点

1 个答案: