CODEWITHSUNDEEP
ms-accessvbaunzipwinzip
Oliver Burdekin
Oliver Burdekin

Reputation: 1108

Force a zip to open unzip to specific location

I'm making a very basic data entry and database system application using excel (for bulk data entry) and Access (to house the data). I play to distribute it as a zip file. In order for it to work I need the file structure to remain unchanged and to unzip to c:/ drive. Is there anyway to force a zip file to unzip to a specific location?

The reason I need this is to automate the uploading of entered data. As far as I know in Access VBA you have to specify full filepaths in VBA to import data.

* Update

Thanks to Remou for getting me out of the woods. Just for posterity's sake this is how I solved it. not the prettiest code but it does the job. First the import function and then the export function.

Importing, a naming convention is still need for the files being uploaded but they can come from anywhere. That file name relates to the tables they will be stored in. At the back end of the excel sheets the data input sheet is split into two (Rec and Occ)

Code as follows:

Function importData_Click(Optional varDirectory As String, _ Optional varTitleForDialog As String) As String

Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As String
Dim strFileName As String
Dim strTableName As String
Dim strColumnName As String
Dim The_Year As Long
Dim occNumber As Long



'Get combobox value and assign relavent values to occNumber
The_Year = Forms![Upload Data]!Year_Combo.value

'Ask the to check value
If MsgBox("Uploading " & The_Year & " data" & vbCrLf & "Continue?", VbMsgBoxStyle.vbYesNo) = 7 Then
    Exit Function
End If



If The_Year = 2012 Then
    occNumber = 1000
    ElseIf The_Year = 2013 Then
    occNumber = 2000
End If

' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
lngFlags = ahtOFN_FILEMUSTEXIST Or _
            ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
    varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
    varTitleForDialog = ""
End If

strFilter = ahtAddFilterItem("Excel Files (*.xlsx)", "*.xlsx")

varFileName = ahtCommonFileOpenSave( _
                                openFile:=True, _
                                InitialDir:=varDirectory, _
                                Filter:=strFilter, _
                                Flags:=lngFlags, _
                                DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then
    varFileName = TrimNull(varFileName)

End If
importData_Click = varFileName

'Sets filename
strFileName = Dir(varFileName)

'Sets TableName
strTableName = Left(strFileName, 4)

If IsNull(strFileName) Then
    MsgBox "Upload cancelled"
    Exit Function
End If






    'Checks naming convetions of filenames

    If strTableName Like "*MN" Or strTableName Like "*OP" Or strTableName Like "*DA" Or strTableName Like "*TR" Then

            'Checks if data is Opportunistic
            If strTableName Like "*OP" Then

            strColumnName = "Year_" & strTableName


                        'Checks to see if that year's data already exists
                        If DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & The_Year & "") Then

                        MsgBox "2012 data is already present"

                        ElseIf DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & The_Year & "") Then

                        MsgBox "2013 data is already present"

                        Else

                        'Uploads data to relevant table
                        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTableName & "_Rec", varFileName, True, "Rec_Prep$"

                        MsgBox "Upload successful"

                        End If



            Exit Function

            Else

            strColumnName = "Occasion_" & strTableName




                        'Checks Occasions to see if that year exists
                        If DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & occNumber & "") Then

                        MsgBox "2012 data is already present"

                        ElseIf DLookup(strColumnName, strTableName & "_Rec", "" & strColumnName & " = " & occNumber & "") Then

                        MsgBox "2013 data is already present"

                        Else
                        'Uploads to Records table and Occasion table
                        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTableName & "_Occ", varFileName, True, "Occ_Prep$"

                        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, strTableName & "_Rec", varFileName, True, "Rec_Prep$"

                        MsgBox "Upload successful"

                        End If

            End If

    Else

    MsgBox "Your file is named incorrectly! & vbCrLf & Please refer to the Data Dictionary & vbCrLf & for correct naming conventions"

    Exit Function

    End If





'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "BaMN_AllData", strSaveFileName



End Function


Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer

intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
    TrimNull = Left(strItem, intPos - 1)
Else
    TrimNull = strItem
End If
End Function

Then the export uses the names of command buttons (that match table names) to export to wherever the user wants:

 Dim queryYear As Variant

'Function to export data to location of users choice.  Query name is automatically     detected from the control button used
'Year is derived from the combobox value on [Extract Data] form, null value defaults to all years.
 Function exportData_Click()


Dim strFilter As String
Dim strSaveFileName As String
Dim The_Year As Variant

Dim ctlCurrentControl As Control
Dim queryName As String



'Get the name of the control button clicked (corresponds to query name to be run)
Set ctlCurrentControl = Screen.ActiveControl
queryName = ctlCurrentControl.Name



'Get combobox value and assign relavent values to The_Year
The_Year = Forms![Extract Data]!Extract_Year.value


'Change the year from a variant to what we need in the SQL

If The_Year Like "20*" Then
    The_Year = CInt(The_Year)
    MsgBox The_Year & "Data Type = " & VarType(The_Year)
Else: The_Year = "*"
MsgBox The_Year & "Data Type = " & VarType(The_Year)
End If

'Set queryYear variable
setYear (The_Year)


'Check the variable is correct
'MsgBox getYear()

'Open the Save as Dialog to choose location of query save

strFilter = ahtAddFilterItem("Excel Files (*.xlsx)", "*.xlsx")

strSaveFileName = ahtCommonFileOpenSave( _
                                openFile:=False, _
                                Filter:=strFilter, _
                Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, queryName, strSaveFileName

End Function
 'Function to set queryYear used in data extraction queries
Public Function setYear(The_Year As Variant)

 queryYear = The_Year

End Function

 'Function to get queryYear used in data extraction queries
 Function getYear()

  getYear = queryYear

 End Function

It should be noted that the file save and file open code sections are not mine. They come from Ken Getz and the whole code can be found here:

http://access.mvps.org/access/api/api0001.htm

Upvotes: 0

Views: 615

Answers (1)

Fionnuala
Fionnuala

Reputation: 91376

It would be better to use the application path ( eg currentproject.Path ) or to ask the user to specify a location for the data store rather than to try to force an install at a location that may not be available to the user. There is no need at all to hard-code paths. In Access, you can store information relevant to the project in a table, including the data path. You can look up MS Access from Excel.

Upvotes: 2

Related Questions