运行时错误5-保存到共享驱动器时

时间:2020-08-12 04:04:43

标签: excel vba

当我保存到本地驱动器时,我的代码可以完美运行,但是当我保存到共享驱动器时,我会遇到运行时错误5?这是怎么发生的?

  • 我有未合并的单元格,并将其作为选择范围的中心
  • 确保整个文档在打印范围内

编辑:我尝试将其保存到上面保存位置的文件夹目录中,并且该目录有效。我了解字符数限制(路径名和标题)可能是问题所在?有办法解决这个问题吗?

错误在以下区域:

'Creating Only the PDF based on Company Network - there is an existing folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Fldr & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

这是整个代码:

Option Explicit
Private Function selectfolder()

'Defining the Variables
Dim user_name As String 
user_name = Environ("username") 'to pick up the username from work environment

'Prompt for folder creation
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Department\" 
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function 'if user does not press OK, end the function'
selectfolder = .SelectedItems(1)

End With

End Function
Sub SaveActiveSheetAsPDF()

'Create a message box to ask user before proceeding
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub

'Defining the Type of Variables
Dim inputrange As Range 'Range represents a cell or multiple cells in Excel
Dim cell As Range
Dim network, Address, Fldr, Title As String

'If user does not choose a folder
Address = selectfolder
If Address = "" Then
    Exit Sub
End If

'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)

For Each cell In inputrange

   Range("G2").Value = cell.Value

'Defining the Company Network Folder variables
network = Range("C6").Value
Fldr = Address & "\" & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"

'Creating the folder based on Company Network - No existing folder
If Dir(Fldr, vbDirectory) = "" Then
'Create a folder
MkDir Fldr
'Save Active Sheet as PDF and to Company Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Fldr & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

'Creating Only the PDF based on Company Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Fldr & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

End If

Next cell
    
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"


End Sub

1 个答案:

答案 0 :(得分:1)

在没有更多信息的情况下很难诊断网络驱动器的问题,但是我可以建议一种解决方法。

您可以将文件保存在本地驱动器上,然后使用VBA中的“文件系统对象”将其移动。看起来像这样:

'Save Active Sheet as PDF in temporary folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Environ("TEMP") & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False


'Move PDF to Company network drive
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.MoveFile Environ("TEMP") & "\" & Title & ".pdf", Fldr & "\" & Title & ".pdf"

请注意,要使此代码正常工作,您需要引用Microsoft Scripting Runtime Library