Private Sub Command1_Click()
    '建立一个ado对象连接
    Dim dataconn As ADODB.Connection
    Dim datarec As ADODB.Recordset
    Dim strsql  As String
    
    '若数据库连接出错，转向connectionErr
    
   ' On Error GoTo connectionErr
   
   Set dataconn = New ADODB.Connection
    
   dataconn.Open "driver={sql server};server=localhost;uid=sa;pwd=4414;database=pubs"
    
    
    '建立数据库的连接
    '若recordset 建立出错，则转向recordsetErr
    
   ' On Error GoTo recordsetErr
    Set datarec = New ADODB.Recordset
        
    strsql = "select au_lname,au_fname,phone,address,city from authors"
    datarec.Open strsql, dataconn, adOpenKeyset, adLockOptimistic
    
    If datarec.EOF Then
        Exit Sub
    End If
    
    Dim excelappx As Excel.Application
    Dim rowcount  As Long
    Dim columncount As Long
    Dim tmpvalue As Variant
    
    rowcount = 3
      
   ' On Error GoTo excelErr
    
    '建立excel应用
    Set excelappx = CreateObject("excel.application")
    
    With excelappx
        .Visible = True
        '新增workbook
        .Workbooks.Add (App.Path & "\authors.xlt")
        
        '添加数据
        
        Do Until datarec.EOF
          '填充每一列
          
          For columncount = 1 To datarec.Fields.Count
            '定位到单元格
            '//////就是下面的这句话出错！
           
            excelappx.Range(excelappx.Cells(columncount, rowcount)).Select
            
            '填充数据
            excelappx.ActiveCell.Value = datarec.Fields(columncount - 1).Value
          
            Next columncount
            
            datarec.MoveNext
            rowcount = rowcount + 1
        Loop
        
        excelappx.Range(excelappx.Cells(3, 1), excelappx.Cells(rowcount - 1, columncount - 1)).Borders.LineStyle = xlContinuous
        
        '打印玉兰
        'excelappx.Worksheets .PrintPreview
        
        excelappx.DisplayAlerts = False
        
        excelappx.Quit
        
        End With
        Exit Sub
        
connectionErr:
     MsgBox "数据库连接错误！"
     Exit Sub

recordsetErr:
     MsgBox "记录集错误！"
     dataconn.Close
     Exit Sub
     
excelErr:
    MsgBox "excel报表有错误！", Err.Description, vbCritical, "出错"
    If Not excelappx Is Nothing Then excelappx.Quit
    datarec.Close
    dataconn.Close
    Exit Sub
End Sub