This Show a Functioning Program that Opens, Saves, and Closes a Workbook
This shows examples of:
(1) Opening a file using FileDialog(msoFileDialogOpen)
(2) Transferring the contents to this workbook
(3) Closing the import file without saving it
(4)
Doing steps 1 through 3 for a second input file
(5) Sorting the combined results of the two imports
(6) Saving the results to a new file using date and time stamps on the output file
(7) Stripping out the VBA on the output file
Program Code
Option Explicit
Public Sub cmdImportCustomerComments()
' ************************************************
' Workbook/Worksheet Assignments
' ************************************************
Dim wkbCustomerCommentsTemplate As Workbook
Dim wkbCustomerAlerts As Workbook
Dim wkbCustomerComments As Workbook
Dim wksCustomerTemplate As Worksheet
Dim wksCustomerAlerts As Worksheet
Dim wksCustomerComments As Worksheet
Dim strImportedWorkbook As String
Dim strFilePathToRawData As String
Dim strSavePath As String
Dim strSaveAsName As String
Dim dlgOpenFile As FileDialog
' ************************************************
' Other Variables
' ************************************************
Dim lngCustomerAlertsLastRow As Long
Dim lngCustomerCommentsLastRow As Long
Dim lngTemplateLastRow As Long
Dim lngFinalRowCount As Long
Dim i As Long
Dim j As Long
Dim rngSortArea As Range
' ************************************************
' Register This Template Workbook
' ************************************************
Set wkbCustomerCommentsTemplate = ThisWorkbook
Set wksCustomerTemplate = wkbCustomerCommentsTemplate.Sheets("CustomerComments")
' ********************************************************************************************
' Open Customer Alerts
' ********************************************************************************************
strFilePathToRawData = ""
Set dlgOpenFile = Application.FileDialog(msoFileDialogOpen)
With dlgOpenFile
.Title = "Select Customer Alerts"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel File", "*.xlsx"
.FilterIndex = 1
.Show
If .SelectedItems.Count < 1 Then
MsgBox ("No File Selected")
Exit Sub
End If
strFilePathToRawData = .SelectedItems(1)
End With
' ************************************************
' Check for Valid Path - If Valid then save
' The Workbook Name and Open It
' ************************************************
If strFilePathToRawData = "" Then
MsgBox ("No File Selected")
Exit Sub
End If
Workbooks.Open strFilePathToRawData
' ************************************************
' Register the External Workbook To Be Imported
' ************************************************
Set wkbCustomerAlerts = ActiveWorkbook
Set wksCustomerAlerts = wkbCustomerAlerts.Sheets(1)
strImportedWorkbook = ActiveWorkbook.Name
' ************************************************
' Validate the correct workbook was opened
' ************************************************
If wksCustomerAlerts.Cells(1, 1) <> "Cust" Then
MsgBox ("File Format Does Not Agree With Expected Format" & vbCrLf & "Import Cancelled")
wkbCustomerAlerts.Close Savechanges:=False
Exit Sub
End If
' ************************************************
' Clear any previous contents of target
' worksheet from the last import
' ************************************************
wksCustomerTemplate.Range(wksCustomerTemplate.Cells(3, 1), wksCustomerTemplate.Cells(10000, 7)).EntireRow.Delete
' ************************************************
' Count the number of rows in the workbook to
' Be Imported
' ************************************************
lngCustomerAlertsLastRow = wksCustomerAlerts.Cells(wksCustomerAlerts.Rows.Count, "A").End(xlUp).Row
' ************************************************
' Populate the worksheet in this application with
' The External Workbook Data - Loop through all
' the external data and copy into this application
' ************************************************
For i = 2 To lngCustomerAlertsLastRow
wksCustomerTemplate.Cells(i + 1, 1) = wksCustomerAlerts.Cells(i, 1)
wksCustomerTemplate.Cells(i + 1, 2) = Date
wksCustomerTemplate.Cells(i + 1, 3) = wksCustomerAlerts.Cells(i, 2)
wksCustomerTemplate.Cells(i + 1, 4) = "IMPORT"
Next i
' ************************************************
' Close the External Workbook
' ************************************************
wkbCustomerAlerts.Close Savechanges:=False
' ************************************************
' Put Cursor to the top of the data just imported
' Into this application
' ************************************************
wkbCustomerCommentsTemplate.Activate
wksCustomerTemplate.Select
wksCustomerTemplate.Cells(1, 1).Select
' ********************************************************************************************
' Open Customer Comments
' ********************************************************************************************
strFilePathToRawData = ""
Set dlgOpenFile = Application.FileDialog(msoFileDialogOpen)
With dlgOpenFile
.Title = "Select Customer Comments"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel File", "*.xlsx"
.FilterIndex = 1
.Show
If .SelectedItems.Count < 1 Then
MsgBox ("No File Selected")
Exit Sub
End If
strFilePathToRawData = .SelectedItems(1)
End With
' ************************************************
' Check for Valid Path - If Valid then save
' The Workbook Name and Open It
' ************************************************
If strFilePathToRawData = "" Then
MsgBox ("No File Selected")
Exit Sub
End If
Workbooks.Open strFilePathToRawData
' ************************************************
' Register the External Workbook To Be Imported
' ************************************************
Set wkbCustomerComments = ActiveWorkbook
Set wksCustomerComments = wkbCustomerComments.Sheets(1)
strImportedWorkbook = ActiveWorkbook.Name
' ************************************************
' Validate the correct workbook was opened
' ************************************************
If wksCustomerComments.Cells(1, 1) <> "Cust" Then
MsgBox ("File Format Does Not Agree With Expected Format" & vbCrLf & "Import Cancelled")
wkbCustomerComments.Close Savechanges:=False
Exit Sub
End If
' ************************************************
' Count the number of rows in the workbook to
' Be Imported
' ************************************************
lngCustomerCommentsLastRow = wksCustomerComments.Cells(wksCustomerComments.Rows.Count, "A").End(xlUp).Row
' ************************************************
' Populate the worksheet in this application with
' The External Workbook Data - Loop through all
' the external data and copy into this application
' ************************************************
' ************************************************
' Count the rows in the template
' ************************************************
lngTemplateLastRow = wksCustomerTemplate.Cells(wksCustomerTemplate.Rows.Count, "A").End(xlUp).Row
j = lngTemplateLastRow
For i = 2 To lngCustomerCommentsLastRow
If wksCustomerComments.Cells(i, 2) <> "" Then
j = j + 1
wksCustomerTemplate.Cells(j, 1) = wksCustomerComments.Cells(i, 1)
wksCustomerTemplate.Cells(j, 2) = Date
wksCustomerTemplate.Cells(j, 3) = wksCustomerComments.Cells(i, 2)
wksCustomerTemplate.Cells(j, 4) = "IMPORT"
End If
If wksCustomerComments.Cells(i, 3) <> "" Then
j = j + 1
wksCustomerTemplate.Cells(j, 1) = wksCustomerComments.Cells(i, 1)
wksCustomerTemplate.Cells(j, 2) = Date
wksCustomerTemplate.Cells(j, 3) = wksCustomerComments.Cells(i, 3)
wksCustomerTemplate.Cells(j, 4) = "IMPORT"
End If
Next i
' ************************************************
' Close the External Workbook
' ************************************************
wkbCustomerComments.Close Savechanges:=False
' ************************************************
' Put Cursor to the top of the data just imported
' Into this application
' ************************************************
wkbCustomerCommentsTemplate.Activate
wksCustomerTemplate.Select
wksCustomerTemplate.Cells(1, 1).Select
' ************************************************
' Sort Final Results
' ************************************************
lngFinalRowCount = wksCustomerTemplate.Cells(wksCustomerTemplate.Rows.Count, "A").End(xlUp).Row
Set rngSortArea = Range(wksCustomerTemplate.Cells(3, 1), wksCustomerTemplate.Cells(lngFinalRowCount, 7))
With wksCustomerTemplate.Sort
.SortFields.Clear
.SortFields.Add Key:= _
Columns("A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
.SetRange rngSortArea
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
strSavePath = Application.ActiveWorkbook.Path & "\"
strSaveAsName = strSavePath & "CustomerComments_" & Format(Date, "YYYY_MM_DD") & "_" & Format(Hour(Now), "00") & Format(Minute(Now), "00")
Application.DisplayAlerts = False
wkbCustomerCommentsTemplate.SaveAs Filename:=strSaveAsName, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
wkbCustomerCommentsTemplate.Close
End Sub