Question

VB里实现将已打开的DOC、PPT复制到指定的文件夹下

我希望在DOC或是PPT文件（这个文件的文件名可能为任意，位置可能是任意目录下）被打开时，自动将这个被打开的文件复制到一个指定的目录下（比如 D:\docppt 文件夹下），而且想用VB来实现

Answer 1

复制代码到窗体运行,一秒锺会检查一次打开的文Word、PPt,并复制到C盤根目录 ，具体检查间隔请自行修改.

Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Dim WithEvents MyTimer As VB.Timer

Private Sub Form_Load()
Set MyTimer = Me.Controls.Add("VB.TIMER", "mytimetest")
MyTimer.Interval = 1000
MyTimer.Enabled = True

End Sub

Private Sub MyTimer_Timer()
On Error Resume Next
Set WordObj = GetObject(, "Word.application")
CopyFile WordObj.activedocument.fullname, "C:\" & WordObj.activedocument.Name, 0
Set PowerPointObj = GetObject(, "PowerPoint.application")
CopyFile PowerPointObj.ActivePresentation.fullname, "C:\" & PowerPointObj.ActivePresentation.Name, 0
End Sub

Answer 2

复制excle ，运行没有错误，但不复制c:\下没有文件，请教 Private Sub Command4_Click()
Dim e As Long '如果 excel在运行，则该 API 调用将返回其句柄。e = FindWindow("XLMAIN", 0) If e = 0 Then

MsgBox "Excel没有运行！" '输出结果
Else
On Error Resume Next
Set vbexcel = GetObject(, "excel.application")
CopyFile vbexcel.ActiveDocument.FullName, "C:\" & vbexcel.ActiveDocument.Name, 0MsgBox "复制完毕" '提示
vbexcel.Quit '退出Word程序
Set vbexcel = Nothing '释放对象
End IfEnd Sub