Save Output
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
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.