Question

已解决：问题与路径有关，某些平板电脑中的Dropbox不在正确的路径中。

下面的代码仅适用于64位系统，由于某种原因，我无法使其在32位系统上运行。尝试删除文件时权限被拒绝。

基本上，以下代码将当前文件保存在新文件夹中，然后删除当前文件，因此该文件不会保存在2个文件夹中。除了“杀死”外，我找不到类似的功能来删除当前文件。有什么想法吗？

Sub RenameFile()

Dim thisWb As Workbook
Set thisWb = ActiveWorkbook

MyOldName = ActiveWorkbook.FullName
Call MoveToNextFolder 'this calls a macro that saves the file in a different folder
Kill MyOldName 'here's where I'm getting the error
ActiveWorkbook.Close

End Sub

Sub MoveToNextFolder()
Dim strFilename, strDirname, strPathname, strDefpath As String
 On Error Resume Next ' If directory exist goto next line
 Calculate
 If Range("AN1").Value = "" Then
 ActiveCell.Offset(0.1).Select
 Else
 GoTo Step1
 End If
 If Range("AO1").Value = "" Then
 ActiveCell.Offset(0.1).Select
 Else
 GoTo Step1
 End If
 If Range("AP1").Value = "" Then
 ActiveCell.Offset(0.1).Select
 Else
 GoTo Step1
 End If
 If Range("AQ1").Value = "" Then
 MsgBox ("Nowhere else to move the file, it's already in the delivered folder")
 Exit Sub
 Else
 GoTo Step1
 End If

Step1:
strDirname = Range("AK2").Value ' New directory name

strFilename = Range("AM1").Value 'New file name
strDefpath = Application.ActiveWorkbook.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
'If IsEmpty(strFilename) Then Exit Sub

MkDir strDirname
strPathname = strDirname & strFilename 'create total string

ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsb", _
FileFormat:=xlExcel12, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Answer 1

备份Excel文件

您将不得不对其进行编辑以满足您的需求。

Sub BackupFile()
'Description
  'Saves this file in a subfolder and kills (erases) it (the file) or,
  'moves this file to a subfolder.
'Preconditions
  '"thisWb" is an open workbook where this procedure in a module resides.
  '"Test" is a subfolder created in the same folder where thisWb resides.

  'Remarks
    'Kills (erases) means there is no copy in the Recycle Bin.
    'If 'thisWb' and 'Test' were on different drives this code would have to be
    'carefully modified.

  Dim MyOldName As String
  Dim thisWb As Workbook

  Set thisWb = ActiveWorkbook

  'You have just made a reference of 'ActiveWorkbook' to 'thisWb',
  'why use 'ActiveWorkbook' any more?
'  MyOldName = ActiveWorkbook.FullName

  MyOldName = thisWb.FullName

  'Remarks
    'If the argument of the ChDrive statement is a multiple-character string,
    'ChDrive uses only the first letter.
    'The CurDir function will return different strings (paths) depending on the
    'way an Excel file is being opened.

  'Prevent 'Run-time error 1004' due to different drives.
  ChDrive thisWb.Path
  'Prevent 'Run-time error 1004' due to different CurDir paths.
  ChDir thisWb.Path

  thisWb.SaveAs "Test\" & thisWb.Name

  Kill MyOldName

  ActiveWorkbook.Close

End Sub

如果仍然出现错误，请尝试调整（更改）当前目录（chDir，CurDir）或更改驱动器（ChDrive），甚至更好地显示MoveToNextFolder过程。

VBA“杀死”功能在32位系统上不起作用

1 个答案:

备份Excel文件