Introduction
निम्नलिखित दिया गया VBA macro, SaveOutput नामक एक subroutine है जो एक Excel workbook को custom file नाम और extension के साथ एक specific directory में saving को automate करता है। Macro potential errors जैसे कि file path या file नाम missing होने को संभालता है और यह सुनिश्चित करता है कि workbook एक valid स्थान पर save की गई है।
Dim FilePath As String
Dim FileName As String
Dim FileExtn As String
Dim wb As Workbook
Set wb = Thisworkbook
FilePath = wb.Sheets(1).Range("A4")
'check if path is blank
If FilePath = "" Then
FilePath = wb.Path
End If
'check if path is incorrect
If Dir(FilePath, vbDirectory) = "" Then
FilePath = wb.Path
End If
'check \ at last of the path
If Right(FilePath, 1) <> "\" Then
FilePath = FilePath & "\"
End If
FileName = wb.Sheets(1).Range("B4")
'check if file name is blank
If FileName = "" Then
FileName = wb.Name & "_" & Format(Date, "ddmmyyyy")
End If
FileExtn = Right(wb.Name, 5)
wb.SaveAs FileName:=FilePath & FileName & FileExtn, AccessMode:=xlShared
End Sub
Code Breakdown
- Variable को Declare करना
Dim FilePath As String
Dim FileName As String
Dim FileExtn As String
Dim wb As Workbook - FilePath: वह directory path है जहाँ workbook save की जाएगी।
- FileName: save की गई workbook file का custom नाम रखता है।
- FileExtn: Workbook का file extension store करता है।
- wb: वर्तमान workbook (ThisWorkbook) को refer करता है, जो macro युक्त workbook को represent करता है।
Open File Dialog Box
Public fd As Office.FileDialog
Public strFile As String
Public wb As Workbook
Sub OpenFileDialogBox()
'open the selected file
Application.ScreenUpdating = False
Call OpenRawDataFile
If strFile = "" Then
Exit Sub
Else
Set wb = Workbooks.Open(strFile)
Call MergeData 'change the procedure name to yours
End If
Workbooks(wb.Name).Close
Set wb = Nothing
Application.ScreenUpdating = True
End Sub
Sub OpenRawDataFile()
'File open dialog box
Dim uName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*", 1
.Filters.Add "Text Files", "*.txt", 2
.Title = "Choose an Excel file"
.AllowMultiSelect = False
'get user name
uName = Environ$("UserName")
If uName = "" Then
uName = Mid(WorksheetFunction.Substitute((Environ$("UserProfile")), "\", "_", 2), WorksheetFunction.Find("_", WorksheetFunction.Substitute((Environ$("UserProfile")), "\", "_", 2)) + 1, 8)
End If
.InitialFileName = "C:\Users\" & uName & "\Downloads"
If .Show = True Then
strFile = .SelectedItems(1)
End If
End With
End Sub
0 टिप्पणियाँ
Please do not enter any spam link in the comment box.