2009-11-13 56 views
0

請告訴我如何更改此訪問代碼,以便刪除單選按鈕,並單擊導入按鈕本身時導入所有4個Excel表單(換句話說,代碼爲所有4個單選按鈕都被執行)。我會很高興,如果你能幫助我但是負面的評論是最歡迎以及:-)如何更改此訪問代碼以便刪除單選按鈕

Option Compare Database 
Option Explicit 


Private Sub cmdImport_Click() 
On Error Resume Next 
If IsNull(Me.txtFileName) Or Len(Me.txtFileName & "") = 0 Then 
    MsgBox "please select the excel file" 
    Me.cmdSelect.SetFocus 
    Exit Sub 
End If 
Select Case Me.FrameSheet 
    Case 1 
    CurrentDb.Execute "delete * from Sheet1" 
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet1", Me.txtFileName, True, "incoming calls!" 
    Case 2 
    CurrentDb.Execute "delete * from Sheet2" 
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet2", Me.txtFileName, True, "incoming sms!" 
    Case 3 
    CurrentDb.Execute "delete * from Sheet3" 
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet3", Me.txtFileName, True, "outgoing calls!" 
    Case 4 
    CurrentDb.Execute "delete * from Sheet4" 
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet4", Me.txtFileName, True, "outgoing sms!" 

    Case Else 
    MsgBox "Select which Sheet you want to import" 
    Exit Sub 


End Select 

End Sub 

Private Sub cmdQuit_Click() 
' DoCmd.Quit 
DoCmd.Close acForm, Me.Name 
End Sub 

Private Sub cmdSelect_Click() 

    Dim strStartDir As String 

    Dim strFilter As String 
    Dim lngFlags As Long 

    ' Lets start the file browse from our current directory 

    strStartDir = CurrentDb.Name 
    strStartDir = Left(strStartDir, Len(strStartDir) - Len(Dir(strStartDir))) 


    strFilter = ahtAddFilterItem(strFilter, _ 
         "Excel Files (*.xls)", "*.xls") 
    Me.txtFileName = ahtCommonFileOpenSave(InitialDir:=strStartDir, _ 
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _ 
        DialogTitle:="Select File") 


End Sub 
+0

你真的應該將「dbFailOnError」添加到所有CurrentDB.Execute語句中,因爲這將確保您不會因不一致的更新而結束,因爲如果整個更新的任何部分都不成功,則整個更新將失敗。 – 2009-11-13 20:55:25

回答

0

只需卸下實際select語句

像這樣

Private Sub cmdImport_Click() 
    On Error Resume Next 
    If IsNull(Me.txtFileName) Or Len(Me.txtFileName & "") = 0 Then 
     MsgBox "please select the excel file" 
     Me.cmdSelect.SetFocus 
     Exit Sub 
    End If 

     CurrentDb.Execute "delete * from Sheet1" 
     DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet1", Me.txtFileName, True, "incoming calls!" 

     CurrentDb.Execute "delete * from Sheet2" 
     DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet2", Me.txtFileName, True, "incoming sms!" 

     CurrentDb.Execute "delete * from Sheet3" 
     DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet3", Me.txtFileName, True, "outgoing calls!" 

     CurrentDb.Execute "delete * from Sheet4" 
     DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Sheet4", Me.txtFileName, True, "outgoing sms!" 

    End Sub 
相關問題