Question

我正在尝试以频繁的间隔拍摄桌面的屏幕截图，并希望将相同的文档doc保存到本地驱动器而不会覆盖。下面是直到doc文档中的屏幕截图时工作正常的代码。但是在尝试保存文件时它会抛出错误。

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan 
As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const VK_SNAPSHOT As Byte = 44
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2
Sub Sample()
Dim savePath As String
Dim i As Integer

Sleep 3000
DoEvents

'~~> Take a snapshot
Call keybd_event(VK_SNAPSHOT, 0, 0, 0)

'~~> Start Word

Set wordobj = CreateObject("Word.Application")

Set objDoc = wordobj.Documents.Add

wordobj.Visible = True

Set objSelection = wordobj.Selection

'Paste into Word
 objSelection.Paste
 objDoc.SaveAs ("C:\Email\Screenshot.docx")


 On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0

 'Determine if File exists
 If TestStr = "" Then
 FileExist = False
  Else
  FileExist = True
 End If

i = 0
savePath = "C:\Email\Screenshot.docx"

While (FileExist(savePath))
savePath = savePath + i
i= i + 1
Wend

objDoc.SaveAs (savePath)
   End Sub

Answer 1

当您尝试保存文件时，错过文件名替换为：

objDoc.SaveAs ("D:\")

以此为例：

objDoc.SaveAs ("D:\filename.docx")

防止文件存在：

Function FileExist(FilePath As String) As Boolean

Dim TestStr As String

  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0

'Determine if File exists
  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If

End Function

在你的保存方法中：

    Dim savePath As String
    Dim i As integer

    i = 0
    savePath = "D:\filename"

    While ( FileExist(savePath)) 
        savePath = savePath + i;
        i++;
   Wend

    objDoc.SaveAs(savePath)

例如，如果您的文件存在，则会增加并在文件名中添加一个数字

Excel VBA代码可以截取并粘贴保存在word中并保存在本地驱动器中

1 个答案: