2009-11-13 50 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