运行 宏两次导致空白结果并不断出现 运行 错误
running macro twice leads to blank result and keep getting running error
我的代码有 2 个问题。
第一个问题：当我第二次运行宏时，我无法将其另存为oriTitle，如果我想更改标题，请回答否。它将只是空白。
第二期：我只能保存2次。之后，我会得到 运行 错误。我想至少坚持 10 次。
有人可以帮我解决这两个问题吗？我不知道该怎么办。提前致谢！
Private Sub CommandButton3_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Entwürfe\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim Title As String
Dim oriTitle As String: oriTitle = "Besprechungsnotizen"
Dim newTitle As String
Dim currentTitle As String
Dim User As String
Dim newUser As String
Dim currentUser As String
Dim Version As Integer
Dim newVersion As Integer
Dim currentVersion As Integer
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
Title = oriTitle
End If
Version = "0"
Else
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & "_" & currentUser
End If
newTitle = MsgBox("Neuer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der neue Titel sein?")
Else
End If
Version = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Version")
If Version = vbYes Then
newVersion = currentVersion + 1
Version = newVersion
Else
Version = currentVersion
End If
End If
ActiveDocument.SaveAs2 FilePath & MyDate & "_" & Title & "_i_0" & Version & "_" & User
End Sub
这里的问题是你根本没有考虑清楚任何事情。您还简单地使用了先前答案中提供给您的代码，而没有先确保您理解它。
切勿使用从 Internet 获得的代码，除非先逐行检查它并确保您完全理解代码的每个部分的作用。您可以使用 Visual Basic 编辑器中的工具来帮助完成此操作。将光标放在您不理解的术语上，然后按 F2 显示对象浏览器，或按 F1 访问联机帮助。
我已经在代码中添加了注释以指出您的错误。
Private Sub CommandButton3_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Entwürfe\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim Title As String
Dim oriTitle As String: oriTitle = "Besprechungsnotizen"
Dim newTitle As String
Dim currentTitle As String
Dim User As String
Dim newUser As String
Dim currentUser As String
Dim Version As Integer
Dim newVersion As Integer
Dim currentVersion As Integer
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
'why are you using Title here when it is the variable used to save the document?
'you should use newTitle for the MsgBox return value
Title = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If Title = vbYes Then
'you should be using the Titlke variable here, not newTitle
newTitle = InputBox("Wie soll der Titel sein?")
'corect the prvious two lines and these next two can be deleted
Title = newTitle
'this sets newTitle to a blank string as you haven't assigned a value to currentTitle yet
newTitle = currentTitle
Else
Title = oriTitle
'this sets oriTitle to a blank string as you haven't assigned a value to currentTitle yet
oriTitle = currentTitle
End If
Version = "0"
Else
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
'if you use an underscore to separate the user names you will not be able to extract
'the version number
'you need to use a different character to separate the names and then use the Split
'function to return those names as an array
User = User & "_" & currentUser
End If
'see comments above
Title = MsgBox("Neuer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If Title = vbYes Then
newTitle = InputBox("Wie soll der neue Titel sein?")
Title = newTitle
newTitle = currentTitle
Else
Title = currentTitle
End If
'comments above also apply here. You should have used the newVersion variable for the MsgBox
Version = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Version")
If Version = vbYes Then
newVersion = currentVersion + 1
Version = newVersion
Else
'you haven't assigned a value to currentVersion yet so it will set Version to zero
Version = currentVersion
End If
End If
ActiveDocument.SaveAs2 FilePath & MyDate & "_" & Title & "_i_0" & Version & "_" & User
End Sub
感谢另一个 post 和 Timothy 的主要帮助，我能够完成我的代码。这是我得到的，以防将来有人尝试类似的事情。
我什至添加了另存为 PDF 的选项，并决定这是否应该是新版本。
这里保存为单词：
Private Sub CommandButton3_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Entwürfe\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim Title As String: Title = "Besprechungsnotizen"
Dim newTitle As String
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim User As String
Dim Version As String
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
Title = nameElements(UBound(nameElements) - 3)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
End If
Version = "0"
Else
Dim currentUser As String
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & currentUser
End If
Version = Format$(Version + 1, "0")
End If
ActiveDocument.SaveAs2 FilePath & MyDate & "_" & Title & "_i_0" & Version & "_" & User
End Sub
这里是PDF部分
Private Sub CommandButton1_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Finale Versionen\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim Title As String: Title = "Besprechungsnotizen"
Dim newTitle As String
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim User As String
Dim Version As String
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
Title = nameElements(UBound(nameElements) - 3)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
End If
Version = "0"
Else
newVersion = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Neue Version")
If newVersion = vbYes Then
Dim currentUser As String
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & currentUser
End If
Version = Format$(Version + 1)
Else
Version = Format$(Version)
End If
End If
ActiveDocument.ExportAsFixedFormat OutputFileName:=FilePath & _
MyDate & "_" & Title & "_i_0" & Version & "_" & User & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
IncludeDocProps:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, _
BitmapMissingFonts:=True
End Sub
我的代码有 2 个问题。
第一个问题：当我第二次运行宏时，我无法将其另存为oriTitle，如果我想更改标题，请回答否。它将只是空白。
第二期：我只能保存2次。之后，我会得到 运行 错误。我想至少坚持 10 次。
有人可以帮我解决这两个问题吗？我不知道该怎么办。提前致谢！
Private Sub CommandButton3_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Entwürfe\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim Title As String
Dim oriTitle As String: oriTitle = "Besprechungsnotizen"
Dim newTitle As String
Dim currentTitle As String
Dim User As String
Dim newUser As String
Dim currentUser As String
Dim Version As Integer
Dim newVersion As Integer
Dim currentVersion As Integer
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
Title = oriTitle
End If
Version = "0"
Else
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & "_" & currentUser
End If
newTitle = MsgBox("Neuer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der neue Titel sein?")
Else
End If
Version = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Version")
If Version = vbYes Then
newVersion = currentVersion + 1
Version = newVersion
Else
Version = currentVersion
End If
End If
ActiveDocument.SaveAs2 FilePath & MyDate & "_" & Title & "_i_0" & Version & "_" & User
End Sub
这里的问题是你根本没有考虑清楚任何事情。您还简单地使用了先前答案中提供给您的代码，而没有先确保您理解它。
切勿使用从 Internet 获得的代码，除非先逐行检查它并确保您完全理解代码的每个部分的作用。您可以使用 Visual Basic 编辑器中的工具来帮助完成此操作。将光标放在您不理解的术语上，然后按 F2 显示对象浏览器，或按 F1 访问联机帮助。
我已经在代码中添加了注释以指出您的错误。
Private Sub CommandButton3_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Entwürfe\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim Title As String
Dim oriTitle As String: oriTitle = "Besprechungsnotizen"
Dim newTitle As String
Dim currentTitle As String
Dim User As String
Dim newUser As String
Dim currentUser As String
Dim Version As Integer
Dim newVersion As Integer
Dim currentVersion As Integer
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
'why are you using Title here when it is the variable used to save the document?
'you should use newTitle for the MsgBox return value
Title = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If Title = vbYes Then
'you should be using the Titlke variable here, not newTitle
newTitle = InputBox("Wie soll der Titel sein?")
'corect the prvious two lines and these next two can be deleted
Title = newTitle
'this sets newTitle to a blank string as you haven't assigned a value to currentTitle yet
newTitle = currentTitle
Else
Title = oriTitle
'this sets oriTitle to a blank string as you haven't assigned a value to currentTitle yet
oriTitle = currentTitle
End If
Version = "0"
Else
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
'if you use an underscore to separate the user names you will not be able to extract
'the version number
'you need to use a different character to separate the names and then use the Split
'function to return those names as an array
User = User & "_" & currentUser
End If
'see comments above
Title = MsgBox("Neuer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If Title = vbYes Then
newTitle = InputBox("Wie soll der neue Titel sein?")
Title = newTitle
newTitle = currentTitle
Else
Title = currentTitle
End If
'comments above also apply here. You should have used the newVersion variable for the MsgBox
Version = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Version")
If Version = vbYes Then
newVersion = currentVersion + 1
Version = newVersion
Else
'you haven't assigned a value to currentVersion yet so it will set Version to zero
Version = currentVersion
End If
End If
ActiveDocument.SaveAs2 FilePath & MyDate & "_" & Title & "_i_0" & Version & "_" & User
End Sub
感谢另一个 post 和 Timothy 的主要帮助，我能够完成我的代码。这是我得到的，以防将来有人尝试类似的事情。 我什至添加了另存为 PDF 的选项，并决定这是否应该是新版本。 这里保存为单词：
Private Sub CommandButton3_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Entwürfe\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim Title As String: Title = "Besprechungsnotizen"
Dim newTitle As String
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim User As String
Dim Version As String
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
Title = nameElements(UBound(nameElements) - 3)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
End If
Version = "0"
Else
Dim currentUser As String
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & currentUser
End If
Version = Format$(Version + 1, "0")
End If
ActiveDocument.SaveAs2 FilePath & MyDate & "_" & Title & "_i_0" & Version & "_" & User
End Sub
这里是PDF部分
Private Sub CommandButton1_Click()
Const FilePath As String = "//SRVDC\Arbeitsordner\Intern\Meetings\Finale Versionen\"
Const OrigFileName As String = "20210910_Besprechungsnotizen_00_"
Dim Title As String: Title = "Besprechungsnotizen"
Dim newTitle As String
Dim MyDate As String: MyDate = Format(Date, "YYYYMMDD")
Dim User As String
Dim Version As String
If Split(ActiveDocument.Name, ".")(0) = OrigFileName Then
'file has not been resaved
Else
'file has been saved before so extract data from filename
Dim nameElements As Variant
nameElements = Split(Split(ActiveDocument.Name, ".")(0), "_")
User = nameElements(UBound(nameElements))
Version = nameElements(UBound(nameElements) - 1)
Title = nameElements(UBound(nameElements) - 3)
End If
If User = "" Then
User = InputBox("Wer erstellt? (Name in Firmenkurzform)")
newTitle = MsgBox("Anderer Titel?", vbQuestion + vbYesNo + vbDefaultButton2, "Titel")
If newTitle = vbYes Then
Title = InputBox("Wie soll der Titel sein?")
Else
End If
Version = "0"
Else
newVersion = MsgBox("Neue Version?", vbQuestion + vbYesNo + vbDefaultButton2, "Neue Version")
If newVersion = vbYes Then
Dim currentUser As String
currentUser = InputBox("Wer bearbeitet? (Name in Firmenkurzform)")
If currentUser = User Then
Else
User = User & currentUser
End If
Version = Format$(Version + 1)
Else
Version = Format$(Version)
End If
End If
ActiveDocument.ExportAsFixedFormat OutputFileName:=FilePath & _
MyDate & "_" & Title & "_i_0" & Version & "_" & User & ".pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
IncludeDocProps:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, _
BitmapMissingFonts:=True
End Sub