ActiveWorkbook.SaveAS filename:=使用特殊字符

时间:2015-05-20 21:10:52

标签: excel vba excel-vba

不可否认,我很难知道这个术语,所以当我我彻底研究过这个时,可能会有一个完美的答案。这是我的困境,我正在开发这个Excel VBA宏来备份和恢复工作表(基本上给了我无限的Undos到我指定的点,并简短地保存和重新开放):

Public BULast As String

Sub Backup()

'This macro imitates videogame save-states. It will save a backup that can replace to current workbook later if you've made an irreversible mistake.

'Step 1: Agree to run away if things go wrong (establish an error handler)
On Error GoTo BackupError

'Step 2: Create some variables
    Dim OriginalFile As String
    Dim BUDir As String
    Dim BUXAr() As String
    Dim BUExt As String
    Dim BUNam As String
    Dim BackupFile As String

'Step 3: Define those variables
    OriginalFile = ActiveWorkbook.FullName
    BUDir = ActiveWorkbook.Path
    BUXAr = Split(ActiveWorkbook.FullName, ".")
    BUExt = BUXAr(UBound(BUXAr))
    BUNam = Replace(ActiveWorkbook.Name, "." & BUExt, "") & " (Back-Up)"
    BackupFile = BUDir & "\" & BUNam & "." & BUExt

'Step 4: Hide the truth
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

'Step 5(A): If there is no backup file, create one using the same file name as the one you're working with and throw a " (Back-up)" on it.
    If Dir(BackupFile) = "" Then

        ActiveWorkbook.SaveAs filename:=BackupFile

        ActiveWorkbook.Close

        Workbooks.Open filename:=OriginalFile

        BUYoN = vbNo

        BULast = Date & ", " & Time

        MsgBox "A Backup has been created!"

    Else

        BUYoN = MsgBox("This will restore the " & BULast & " backup and undo all changes made to this project. Continue?" _
            , vbYesNo, "Revert to Backup?")

    End If

'Step 5(B): If a backup has been created, restore it over the current workbook and delete the backup.
    If BUYoN = vbYes Then

        ActiveWorkbook.Close

        Workbooks.Open filename:=BackupFile

        ActiveWorkbook.SaveAs filename:=OriginalFile

        Kill (BackupFile)

        BUCheck = "Dead"

    End If

'Step 6: Put things back to the way you found them, you're done!
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Exit Sub

'Step 1 (Continued): If nothing went wrong, stop worrying about it, if something did, say it didn't work and go away.

On Error GoTo 0

BackupError:

    MsgBox "Attempt to Backup or Restore was unsuccessful"

End Sub

通常它按预期工作,但就在昨天它开始不起作用,在玩完它之后我意识到这是因为我在一个文件名中带有Ω符号的文件上尝试它。

基本过程是在当前目录中查找活动工作簿的文件名,但最后添加(备份)。它将创建一个,或用它找到的东西替换它。但是,当在Ω文件上完成时,它会用O替换该字符。再次运行时,显然正确搜索Ω,因为它找不到任何(即使O替换文件正确)在那里很明显。)

我知道最简单的解决方案是确保人们将文件名保存在键盘上可以看到的内容,但这对我不起作用;我几乎虔诚地将适应性放在代码中而不是用户身上。因此,对于这个冗长的背景故事,这是我的具体问题:

VBA中是否存在可以处理指定文件名中特殊字符的SaveAs函数或实用解决方法?

2 个答案:

答案 0 :(得分:1)

问题在于Dir()函数,因为它在检查文件之前将特殊字符转换为ANSI,因此在这些情况下失败。改为使用FileSystemObject对象:

Sub Backup()

On Error GoTo BackupError

    Dim OriginalFile As String
    OriginalFile = ActiveWorkbook.FullName

    ' get back up file name
    Dim BackupFile As String
    Dim pos As Integer
    pos = InStrRev(OriginalFile, ".")
    BackupFile = Mid$(OriginalFile, 1, pos - 1) & " (Back-Up)." & Mid$(OriginalFile, pos + 1)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

'Step 5(A): If there is no backup file, create one using the same file name as the one you're working with and throw a " (Back-up)" on it.
    Dim BUYoN As VbMsgBoxResult
    Dim BULast As String
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    With fs
        If Not .FileExists(BackupFile) Then

            ActiveWorkbook.SaveAs Filename:=BackupFile
            ActiveWorkbook.Close
            Workbooks.Open Filename:=OriginalFile
            BUYoN = vbNo
            BULast = Date & ", " & Time
            MsgBox "A Backup has been created!"

        Else
            BUYoN = MsgBox("This will restore the " & BULast & " backup and undo all changes made to this project. Continue?" _
                , vbYesNo, "Revert to Backup?")

        End If
    End With


'Step 5(B): If a backup has been created, restore it over the current workbook and delete the backup.
    If BUYoN = vbYes Then
        ActiveWorkbook.Close
        Workbooks.Open Filename:=BackupFile
        ActiveWorkbook.SaveAs Filename:=OriginalFile
        'Kill (BackupFile)
        fs.Delete BackupFile
        Dim BUCheck As String
        BUCheck = "Dead"

    End If

'Step 6: Put things back to the way you found them, you're done!
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Exit Sub


On Error GoTo 0

BackupError:
    MsgBox "Attempt to Backup or Restore was unsuccessful"
End Sub

答案 1 :(得分:0)

我知道我们不应该提供意见,但我认为Rachel是个天才!我不知道FileSystemObject,但最终成为关键。它不仅能够搜索和识别带有特殊字符的文件,而且它似乎也可以删除它。将其整合到代码中可以使用或不使用特殊字符运行完美:

Public BULast As String

Sub Backup()

'This macro imitates videogame save-states. It will save a backup that can replace the
'current workbook later if you've made an irreversible mistake.

'Step 1: Agree to run away if things go wrong (establish an error handler)
    On Error GoTo BackupError

'Step 2: Create some variables
    Dim OriginalFile As String
    Dim BUDir As String
    Dim BUXAr() As String
    Dim BUExt As String
    Dim BUNam As String
    Dim BackupFile As String
    Dim BUfs As Object

'Step 3: Define those variables
    OriginalFile = ActiveWorkbook.FullName
    BUDir = ActiveWorkbook.Path
    BUXAr = Split(ActiveWorkbook.FullName, ".")
    BUExt = BUXAr(UBound(BUXAr))
    BUNam = Replace(ActiveWorkbook.Name, "." & BUExt, "") & " (Back-Up)"
    BackupFile = BUDir & "\" & BUNam & "." & BUExt
    Set BUfs = CreateObject("Scripting.FileSystemObject")


'Step 4: Hide the truth
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

'Step 5(A): If there is no backup file, create one using the same file name as the one
'you're working with and throw a " (Back-up)" on it.

    With BUfs
        If Not .FileExists(BackupFile) Then

            ActiveWorkbook.Save
            ActiveWorkbook.SaveAs filename:=BackupFile

            ActiveWorkbook.Close

            Workbooks.Open filename:=OriginalFile

            BUYoN = vbNo

            BULast = Date & ", " & Time

            MsgBox "A Backup has been created!"

        Else

            BUYoN = MsgBox("This will restore the " & BULast & " backup and undo all changes made to this project. Continue?" _
                , vbYesNo, "Revert to Backup?")

        End If
    End With

'Step 5(B): If a backup has been created, restore it over the current workbook and
'delete the backup.
    If BUYoN = vbYes Then

        ActiveWorkbook.Close

        Workbooks.Open filename:=BackupFile

        ActiveWorkbook.SaveAs filename:=OriginalFile

        BUfs.DeleteFile BackupFile, True

    End If

'Step 6: Put things back to the way you found them, you're done!
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Exit Sub


'Step 1 (Continued): If nothing went wrong, stop worrying about it, if something did,
'say it didn't work and go away.

On Error GoTo 0

BackupError:

    MsgBox "Attempt to Backup or Restore was unsuccessful"

End Sub