Data Import Challenge

Option Compare Database
Option Explicit

Sub importXL()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim i As Long
Dim strFilter2 As String
Dim strStartDir As String
Dim varFileName As Variant
Dim strSavePath As String

'set path to save modified XLS file
strSavePath = "c:\MyFilez.XLS"

'Set filter for file dialog
strFilter2 = "Excel (*.xls)" & vbNullChar & "*.xls" _
& vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
' Set default directory to look in
strStartDir = "C:\My Documents\DataBases"

'get file path -- if you dont need to select the file each time
' then just set the file path in varFileName and get rid of this bit
varFileName = tsGetFileFromUser(strFilter:=strFilter2, strInitialDir:=strStartDir)
If IsNull(varFileName) Then
    MsgBox "No File Selected!", vbCritical, "Selection Error"
Exit Sub
End If
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open(varFileName, , True)
Set xlSheet = xlWB.Worksheets(1)

With xlSheet
    For i = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If .Range("A" & i) = "" Then
            .Range("A" & i).EntireRow.Delete
        End If
    Next i
    For i = 1 To .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        If .Range("af" & i) = "" Then
            .Range("af" & i) = .Range("af" & i - 1)
        End If
    Next i
End With
On Error Resume Next
Kill strSavePath ' get rid of old copy
xlWB.Close SaveChanges:=True, Filename:=strSavePath
xlApp.Quit
Set xlSheet = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

'.=
'.Browse Files Module
'.Copyright 1999 Tribble Software.  All rights reserved.
'.Phone        : (616) 455-2055
'.E-mail       : carltribble@earthlink.net
' INSTRUCTIONS:
'
'         ( For a working example, open the Debug window  )
'         ( and enter tsGetFileFromUserTest.              )
'
'.All the arguments for the function are optional.  You may call it with no
'.arguments whatsoever and simply assign its return value to a variable of
'.the Variant type.  For example:
'.
'.   varFileName = tsGetFileFromUser()
'.
'.The function will return:
'.   the full path and filename selected or entered by the user, or
'.   Null if an error occurs or if the user presses Cancel.
'.
'.Optional arguments may include any of the following:
'. rlngFlags      : one or more of the tscFN* constants (declared below)
'.                  Combine multiple constants like this:
'.                   tscFNHideReadOnly Or tscFNFileMustExist
'. strInitialDir : the directory to display when dialog opens
'. strFilter     : a string containing any filters you want to use. Each
'.                 part must be separated by the vbNullChar. -example below
'. lngFilterIndex: a 1-based index indicating which filter to start with.
'. strDefaultExt : Extension to use if user does not enter one.
'. strFileName   : Default File to display in the File Name text box.
'. strDialogTitle: Caption to display in the dialog's title bar.
'. fOpenFile     : Boolean-True for the Open dialog, False for Save dialog.
'
' FILTER EXAMPLE: The filter must be a string containing two parts for each
'  filter.  The first part is the Description, it is what the user will see
'  in the Files of Type box, e.g. "Text Files (*.txt)".  The second part is
'  the actual filter, e.g. "*.txt".  Each part and each filter must be
'  separated by the vbNullChar.  For example, to provide two filters, one for
'  *.mdb files, and one for all files, use a statement like this:
'
'  strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
'   & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
'
'  Then pass your strFilter variable as the strFilter argument for the call
'  to tsGetFileFromUser()
'
'.-
Option Compare Database
Option Explicit

Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
 Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
 Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Type tsFileName
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   strFilter As String
   strCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   strFile As String
   nMaxFile As Long
   strFileTitle As String
   nMaxFileTitle As Long
   strInitialDir As String
   strTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   strDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type

' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
    Optional ByRef rlngflags As Long = 0&, _
    Optional ByVal strInitialDir As String = "", _
    Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
    Optional ByVal lngFilterIndex As Long = 1, _
    Optional ByVal strDefaultExt As String = "", _
    Optional ByVal strFileName As String = "", _
    Optional ByVal strDialogTitle As String = "", _
    Optional ByVal fOpenFile As Boolean = True) As Variant
On Error GoTo tsGetFileFromUser_Err
    
    Dim tsFN As tsFileName
    Dim strFileTitle As String
    Dim fResult As Boolean

    ' Allocate string space for the returned strings.
    strFileName = Left(strFileName & String(256, 0), 256)
    strFileTitle = String(256, 0)

    ' Set up the data structure before you call the function
    With tsFN
        .lStructSize = Len(tsFN)
        .hwndOwner = Application.hWndAccessApp
        .strFilter = strFilter
        .nFilterIndex = lngFilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle
        .flags = rlngflags
        .strDefExt = strDefaultExt
        .strInitialDir = strInitialDir
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
        .lpfnHook = 0
    End With
   
    ' Call the function in the windows API
    If fOpenFile Then
        fResult = ts_apiGetOpenFileName(tsFN)
    Else
        fResult = ts_apiGetSaveFileName(tsFN)
    End If

    ' If the function call was successful, return the FileName chosen
    ' by the user.  Otherwise return null.  Note, the CancelError property
    ' used by the ActiveX Common Dialog control is not needed.  If the
    ' user presses Cancel, this function will return Null.
    If fResult Then
        rlngflags = tsFN.flags
        tsGetFileFromUser = tsTrimNull(tsFN.strFile)
    Else
        tsGetFileFromUser = Null
    End If

tsGetFileFromUser_End:
    On Error GoTo 0
    Exit Function

tsGetFileFromUser_Err:
    Beep
    MsgBox Err.DESCRIPTION, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsGetFileFromUser"
    Resume tsGetFileFromUser_End

End Function

' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
    Dim i As Integer
   
    i = InStr(strItem, vbNullChar)
    If i > 0 Then
        tsTrimNull = Left(strItem, i - 1)
    Else
        tsTrimNull = strItem
    End If
    
tsTrimNull_End:
    On Error GoTo 0
    Exit Function

tsTrimNull_Err:
    Beep
    MsgBox Err.DESCRIPTION, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsTrimNull"
    Resume tsTrimNull_End

End Function