Question

我有一个单词形式，只要点击提交，它就会向电子邮件地址发送通知并将文件保存到某个位置。我有一个如下脚本，我想在表单中输入数据并单击提交第二次时保存的文件应该有不同的名称，因为如果再次运行下面的脚本，它将覆盖当前保存的表单那个位置。

Private Sub CommandButton1_Click()

Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document


Application.ScreenUpdating = False

Set OL = CreateObject("Outlook.Application")

Set EmailItem = OL.CreateItem(olMailItem)

Set Doc = ActiveDocument
Doc.Save
Doc.SaveAs2 "d:/abcd.docx"

With EmailItem

    .Subject = "Test"
    .Body = "Test"
    .To = "jaiswalrohitkr@gmail.com"
    .Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
    .Attachments.Add Doc.FullName
    .Send

End With

Application.ScreenUpdating = True

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

End Sub

Answer 1

您可以使用全局计数器和FileSystemObject来完成此操作。

'Global Variable to hold our iteration count
Public docCount As Integer
Private Sub CommandButton1_Click()

Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document
Dim DocName         As String
'add a reference to Microsoft Scripting Runtime
Dim fso             As FileSystemObject
Set fso = New FileSystemObject



Application.ScreenUpdating = False

Set OL = CreateObject("Outlook.Application")

Set EmailItem = OL.CreateItem(olMailItem)

Set Doc = ActiveDocument
Doc.Save

DocName = "d:/abcd.docx"
'use the fileSystemObject to check if the file already exists
Do While fso.FileExists(DocName) = True
    DocName = "d:/abcd" & CStr(docCount) & ".docx"
    'add one to the counter to check again
    docCount = docCount + 1
Loop
Doc.SaveAs2 DocName

With EmailItem
    If docCount > 0 Then
        'more than one iteration so adjust name
        .Subject = "Test" & CStr(docCount)
    Else
        'first iteration so leave it as test
        .Subject = "Test"
    End If
    .Body = "Test"
    .To = "jaiswalrohitkr@gmail.com"
    .Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
    .Attachments.Add Doc.FullName
    .Send

End With

Application.ScreenUpdating = True

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

End Sub

使用名称保存文件

1 个答案: