標題:
[發問]
在資料夾中判斷有無相同檔名再儲存
[打印本頁]
作者:
s13030029
時間:
2019-6-18 15:09
標題:
在資料夾中判斷有無相同檔名再儲存
我的程式是要將我的工作表匯出成無巨集的活頁簿
所以我的程式會自動建立一個資料夾,再把我的檔案匯出至那個資料夾
但是我現在的程式沒辦法判斷資料夾裡有無重複的檔名
所以我希望能加入判斷有相同名稱就跳回inputbox重新輸入檔名
如果沒有相同檔名就直接儲存
希望能有高手幫忙~~~~~~~感激不盡~~~~~~~~
Sub 匯出製程記錄表()
Titlename = ThisWorkbook.Sheets("製程檢查記錄表").Range("H4").Value
Dim ylFolder As String
ylFolder = ThisWorkbook.Path & "\" & Titlename & "記錄表" '指定資料夾
If Dir(ylFolder, vbDirectory) = "" Then MkDir ylFolder
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveSheet
.Copy
ActiveSheet.DrawingObjects.Delete
X = InputBox("請輸入檔名!!", "另存新檔", Titlename & " " & "檢驗報告")
If X <> "" Then
Application.ActiveWorkbook.SaveAs Filename:=ylFolder & "\" & X, _
FileFormat:=xlExcel8
MsgBox "儲存成功!"
ElseIf X = "" Then
MsgBox "已取消儲存!!!"
End If
Application.ErrorCheckingOptions.BackgroundChecking = False
Application.ActiveWorkbook.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
複製代碼
[attach]30895[/attach]
作者:
kim223824
時間:
2019-6-18 16:02
你輸入的檔名可串上日期+時間就不會重複的問題 yyyymmddhhmm
作者:
kim223824
時間:
2019-6-18 16:04
回復
1#
s13030029
你輸入的檔名可串上日期+時間就不會重複的問題 yyyymmddhhmm
作者:
s13030029
時間:
2019-6-18 16:34
回復
3#
kim223824
因為我想要由使用者自訂名稱,所以才不加日期
作者:
s13030029
時間:
2019-6-18 16:38
回復
1#
s13030029
已解決~~
提供程式碼給大家參考
Sub 匯出製程記錄表()
Titlename = ThisWorkbook.Sheets("製程檢查記錄表").Range("H4").Value
Dim ylFolder As String
ylFolder = ThisWorkbook.Path & "\" & Titlename & "記錄表" '指定資料夾
If Dir(ylFolder, vbDirectory) = "" Then MkDir ylFolder
Dim stFileName As String
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveSheet
.Copy
ActiveSheet.DrawingObjects.Delete
XX:
X = InputBox("請輸入檔名!!", "另存新檔", Titlename & " " & "檢驗報告")
stFileName = ylFolder & "\" & X & ".xls"
If X <> "" Then
If Dir(stFileName) <> "" Then
MsgBox "已有相同檔名!"
GoTo XX
Else
Application.ActiveWorkbook.SaveAs Filename:=ylFolder & "\" & X, _
FileFormat:=xlExcel8
MsgBox "儲存成功!"
End If
ElseIf X = "" Then
MsgBox "已取消儲存!!!"
End If
Application.ErrorCheckingOptions.BackgroundChecking = False
Application.ActiveWorkbook.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
複製代碼
參考資料:https://analysistabs.com/excel-vba/check-file-exists-location-folder/
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)