VBA将单元格内容作为文件保存路径？

Question

诉求：编辑“另存为”的VBA代码来实现根据D3单元格内容保存报表到相应路径,D3单元格可能出现的内容有：苹果、香蕉，桔子，火龙果，猕猴桃，榴莲等如：D3单元格为香蕉，则保存到D:\日报\2023年日报表\香蕉

Answer 1

这段代码将根据D3单元格的内容将当前工作表另存为一个新文件，保存到相应的文件夹。
Sub SaveWorkbookByCellContent()
Dim ws As Worksheet
Dim folderPath As String
Dim fileName As String
Dim fileExtension As String
Dim cellContent As String
Set ws = ThisWorkbook.Worksheets("Sheet1") ' 更改为您需要保存的工作表名称
cellContent = ws.Range("D3").Value
folderPath = "D:\日报\2023年日报表\" & cellContent & "\"
If Len(Dir(folderPath, vbDirectory)) = 0 Then
MkDir folderPath
End If
fileName = "报表_" & Format(Now(), "yyyyMMdd") ' 根据需要更改文件名和日期格式
' 获取当前工作簿的默认文件扩展名
fileExtension = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."))
' 保存文件到指定路径
ws.Copy
With ActiveWorkbook
.SaveAs folderPath & fileName & fileExtension
.Close False
End With
End Sub
在使用此代码之前，请确保将ws变量中的工作表名称更改为您需要保存的工作表名称。此代码将根据D3单元格的内容创建文件夹（如果不存在），然后将工作表另存为该文件夹中的一个新文件。文件名将包含报表和当前日期。

Answer 2

顺手 一写，没测试，你自己测。

Sub 另存为测试()

'检查D3是否已填写

If Range("D3").Value = "" Then '如果是空的

MsgBox "D3单元格不能为空！", 16

Exit Sub '退出

End If

'检查路径是否存在

Dim ipath As String

ipath = "D:\日报\2023年日报表\" & Range("D3").Value & "\" '连接出文件夹的路径

If Dir(ipath, vbDirectory) = "" Then '如果路径不存在

MsgBox "该路径不存在", 16

Exit Sub '退出

End If

'若文件存在则询问是否覆盖

ipath = ipath & ThisWorkbook.Name '再连接上这个工作簿的文件名

If Not Dir(ipath, vbDirectory) = "" Then '如果文件存在

If MsgBox("该文件已存在，" & vbLf & "是否强行覆盖？", 1 + 32) = vbCancel Then '若对话框返回值是vbCancel

Exit Sub '用户点了"否"则退出

End If

End If

'执行另存为命令并提示

ActiveWorkbook.SaveAs Filename:=ipath '另存为

MsgBox "保存成功！" & vbLf & "文件路径：" & vbLf & ipath, 64

End Sub