Принудительно открыть молнию распаковать в определенное место

Question

Я делаю очень простое приложение для ввода данных и системы баз данных, используя Excel (для массового ввода данных) и Access (для размещения данных). Я играю, чтобы распространять его в виде zip-файла. Чтобы он работал, мне нужно, чтобы структура файла осталась неизменной и разархивировать на диск c:/. Есть ли способ заставить почтовый файл распаковать в определенное место?

Мне нужна эта причина, чтобы автоматизировать загрузку введенных данных. Насколько я знаю в Access VBA, вы должны указать полные пути к файлам в VBA для импорта данных.

* Обновление

Спасибо Рему за то, что вытащил меня из леса. Ради потомков, вот как я это решил. не самый красивый код, но он делает свою работу. Сначала функция импорта, а затем функция экспорта.

Для импорта по-прежнему необходимо соглашение о присвоении имен для загружаемых файлов, но они могут поступать откуда угодно. Это имя файла относится к таблицам, в которых они будут храниться. В конце листов Excel лист ввода данных разделен на две части (Rec и Occ).

Код следующим образом:

Функция importData_Click(Необязательный varDirectory As String, _ Необязательный varTitleForDialog As String) Как 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

Затем экспорт использует имена командных кнопок (которые соответствуют именам таблиц) для экспорта туда, куда пользователь хочет:

 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

Следует отметить, что разделы сохранения файла и открытого кода не мои. Они приходят от Кена Гетца, и весь код можно найти здесь:

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

Answer 1

Было бы лучше использовать путь к приложению (например, currentproject.Path) или попросить пользователя указать местоположение для хранилища данных, а не пытаться принудительно выполнить установку в месте, которое может быть недоступно для пользователя. Нет необходимости вообще жестко кодировать пути. В Access вы можете хранить информацию, относящуюся к проекту, в таблице, включая путь к данным. Вы можете посмотреть MS Access из Excel.