Save Workbook and File Open Dialog Box

VBA code to save workbook

Introduction

निम्नलिखित दिया गया VBA macro, SaveOutput नामक एक subroutine है जो एक Excel workbook को custom file नाम और extension के साथ एक specific directory में saving को automate करता है। Macro potential errors जैसे कि file path या file नाम missing होने को संभालता है और यह सुनिश्चित करता है कि workbook एक valid स्थान पर save की गई है। 

Sub SaveOutput()
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

  1. 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 टिप्पणियाँ