时间戳

首页 > 解决方案 > VBA从数据验证列表创建文件夹并允许用户选择文件夹

excel - VBA从数据验证列表创建文件夹并允许用户选择文件夹

问题描述

我的代码遇到了三个问题。

  1. 当用户选择一个保存文件夹时，它总是保存在上面的文件夹中。例如，如果地址是“Dept\Financial Analysis Team - General\Mail Out”，它将始终保存到 Financial Analysis Team - General 文件夹，即使 Mail Out 是我单击的文件夹。
  2. 每次循环时，我都会收到保存提示。我的宏循环遍历数据验证列表，创建一个文件夹（如果没有）并将指定的 PDF 保存到它们各自的文件夹中。用户可以在我选择的驱动器中选择他们想要的任何文件夹。
  3. 如果我不选择文件夹（即取消），宏会自行运行并实际创建文件夹和 PDF。
Function selectfolder()
user_name = Environ("username")
Dim flder As FileDialog
Dim foldername As String
Set flder = Application.FileDialog(msoFileDialogFolderPicker) 'standard wording

'Prompt for folder creation
With flder
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Dept\"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode 'i.e. if OK is not pressed
foldername = .SelectedItems(1)

End With

NextCode:
GetFolder = foldername
Set flder = Nothing

End Function

Sub SaveActiveSheetAsPDF()

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

Dim inputrange As Range
Dim cell As Range
Dim network, Address, Folder, Title As String

'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 Network Folder variables
network = Range("C6").Value
Address = selectfolder
Folder = Address & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"

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

'Creating Only the PDF based on Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Folder & "\" & 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

标签： excelvba

解决方案

  1. 我建议您在不同部分插入代码以查看变量是什么。（要添加断点，请单击左侧的灰色区域以添加红色圆圈。）

    文件夹 = 地址和网络

你的“地址”变量可能不会以斜线结尾，所以我猜你需要类似的东西：Address & "\" & network

如果您在创建 pdf 的行上中断，则可以在调试窗口中键入

?Folder & "\" & Title & ".pdf"

这可能会显示为什么您的文件没有保存在您想要的位置。您还可以创建一个变量 saveAs 来存储完整路径，从而更容易查看值。

  1. 您应该将代码移动到 for 循环之外向用户询问目录的顶部。我假设您只需要询问一次目录。

如果用户没有选择一个文件夹，你想退出，但你没有代码来处理这个。像下面这样的东西应该可以工作：

address = SelectFolder
If address = "" Then
    MsgBox "Canceled."
    Exit Sub
End If

推荐阅读