0
저는 엑셀 (대량 데이터 입력 용) 및 액세스 (데이터 보관 용)를 사용하여 매우 기본적인 데이터 입력 및 데이터베이스 시스템 응용 프로그램을 만들고 있습니다. zip 파일로 배포합니다. 이 파일이 작동하려면 파일 구조를 변경하지 않고 c :/드라이브에 압축을 해제해야합니다. 특정 위치에 압축 파일을 강제로 압축하도록 할 여지가 있습니까?특정 위치로 압축 해제를 강제 실행하십시오.
내가 필요한 이유는 입력 된 데이터의 업로드를 자동화하기 위해서입니다. 내가 아는 한 Access VBA에서 데이터를 가져 오기 위해 VBA에서 전체 파일 경로를 지정해야합니다. 숲에서 저를 얻기를위한 Remou에
* 업데이트
감사합니다. 후손을 위해서 이것은 내가 어떻게 해결 했는가입니다. 가장 예쁜 코드는 아니지만 일을합니다. 먼저 가져 오기 기능과 내보내기 기능.
업로드 할 때 파일 업로드에는 이름 지정 규칙이 필요하지만 어디에서나 올 수 있습니다. 즉, 파일명은 저장 될 테이블에 관한 다음과 같은 데이터 입력 시트 두 (REC 및 OCC)
코드로 분할 엑셀 시트의 후단에서 :.
기능 importData_Click (선택
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
그런 다음 내보내기가 사용자가 원하는 곳으로 내보낼 명령 단추 (일치하는 테이블 이름)의 이름을 사용하여 문자열로 varDirectory로 문자열 문자열로 _ 옵션 varTitleForDialog) :
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
감사합니다. 나는 방금 zip 압축 풀기 (.exe 사용)를 시작했습니다. 경로를 하드 코딩하는 방법은 무엇입니까? –
내가 말했듯이 응용 프로그램 경로 (예 : currentproject.Path)를 사용하거나 사용자에게 데이터 위치를 찾아 보도록 요청합니다. – Fionnuala