那位大神帮我在这段代码里面加上新建文件夹的代码！

lkuhcc

Sub 备份另存为PDF()
On Error Resume Next
Dim sName
sName = ActiveWorkbook.path & "\备份\" & [O1] & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub



有没有大神帮我在保存前面，加一段新建“备份”文件夹的代码。

yuyubiao

lkuhcc 发表于 2023-4-28 15:08
如果我想在新建了"备份"文件夹的同时,新建一个"提交"的文件夹.
应该怎么加代码?
如果有备份文件夹产生, ...

Sub 备份另存为PDF()
On Error Resume Next
Dim sPath1 As String,sPath2 As String
Dim sName As String
sPath1 = ActiveWorkbook.path & "\备份\" '新建文件夹名
sPath2= ActiveWorkbook.path & "\提交\" '新建文件夹名
If Dir(sPath1, vbDirectory) = "" Then
MkDir sPath1
MkDir sPath2
End If
sName = sPath1 & [O1] & ".pdf" '文件名单元格
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

yuyubiao

1. Sub 备份另存为PDF()
   
2. On Error Resume Next
   
3. Dim sPath As String
   
4. Dim sName As String
   
5. sPath = ActiveWorkbook.Path & "\备份"
   
6. If Dir(sPath, vbDirectory) = "" Then
   
7. MkDir sPath
   
8. End If
   
9. sName = sPath & [O1] & ".pdf"
   
10. ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sName, Quality:=xlQualityStandard, _
    
11. IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
12. End Sub

复制代码

mmwwdd

mkdir thisworkbook.path & “\备份”

lkuhcc

mmwwdd 发表于 2023-4-28 06:48
mkdir thisworkbook.path & “\备份”

测试成功,感谢大神!!!!

lkuhcc

yuyubiao 发表于 2023-4-28 00:15

测试成功了,谢谢大神

lkuhcc

yuyubiao 发表于 2023-4-28 00:15

这两段代码放在一起有用吗?需要怎么修改.

Sub 备份另存为PDF()
On Error Resume Next
Dim sPath As String
Dim sName As String
sPath = ActiveWorkbook.path & "\备份\" '新建文件夹名
If Dir(sPath, vbDirectory) = "" Then
MkDir sPath
End If
sName = sPath & [O1] & ".pdf" '文件名单元格
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
----------------------------------------------------------------------------------
Function fileExists(ByVal strFileName As String) As Boolean
    '某文件是否存在
    If Dir(strFileName, 16) <> Empty Then
        fileExists = True
    Else
        fileExists = False
    End If
End Function

yuyubiao

lkuhcc 发表于 2023-4-28 11:12
这两段代码放在一起有用吗?需要怎么修改.

Sub 备份另存为PDF()

你是想在保存之前先判断文件是否存在是吧？如果存在想要什么操作？不存在又怎么操作？，我觉得把下面这段代码放进主程序就可以了。
If Dir(strFileName, 16) <> Empty Then
        fileExists = True
    Else
        fileExists = False
    End If

lkuhcc

yuyubiao 发表于 2023-4-28 11:16
你是想在保存之前先判断文件是否存在是吧？如果存在想要什么操作？不存在又怎么操作？，我觉得把下面这段 ...

我想如果把文件名后面加上当前时间,就可以不用检查文件重复这一步的代码 了.

yuyubiao

lkuhcc 发表于 2023-4-28 12:49
我想如果把文件名后面加上当前时间,就可以不用检查文件重复这一步的代码 了.

Sub 备份另存为PDF()
On Error Resume Next
Dim sPath As String
Dim sName As String
Dim currentTime As String
   
    '获取当前日期
    currentTime = Format(Now(), "hh时mm分ss秒")
sPath = ActiveWorkbook.Path & "\备份\" '新建文件夹名
If Dir(sPath, vbDirectory) = "" Then
MkDir sPath
End If
sName = sPath & [O1] & currentTime & ".pdf" '文件名单元格
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

lkuhcc

yuyubiao 发表于 2023-4-28 14:19
Sub 备份另存为PDF()
On Error Resume Next
Dim sPath As String

如果我想在新建了"备份"文件夹的同时,新建一个"提交"的文件夹.
应该怎么加代码?
如果有备份文件夹产生,会生成一个"提交"的文件夹.只是新建"提交"文件夹,不做其它操作.用于我后期往里存文件.
-------------------------------
Sub 备份另存为PDF()
On Error Resume Next
Dim sPath As String
Dim sName As String
sPath = ActiveWorkbook.path & "\备份\" '新建文件夹名
If Dir(sPath, vbDirectory) = "" Then
MkDir sPath
End If
sName = sPath & [O1] & ".pdf" '文件名单元格
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub