关于导出Excel的问题，在线等。。。

Question

我的数据导出到Excel后，会出现“ddd.xls”不是Microsoft Excel97格式，要保留修改吗？
这个提示栏在每次导完数据后都会出现，很讨厌，请问怎么去掉？

Answer 1

关闭的时候加个参数，如：xlsWork.Close (True)

Answer 2

引用的Excel Library 是什么版本的，是否与当前Office安装的版本不同Project-Reference-Microsoft Excel 10.0 Object Library

Answer 3

SaveAs 方法
                expression.SaveAs(Filename, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AddToMru, TextCodePage, TextVisualLayout)
FileFormat 属性
                返回工作簿的格式或者类型。Long 类型，只读。可为以下 XlFileFormat 常量之一：xlAddIn 
xlCSVxlCSVMacxlCSVMSDOSxlCSVWindowsxlCurrentPlatformTextxlDBF2xlDBF3xlDBF4xlDIFxlExcel2xlExcel2FarEastxlExcel3xlExcel4xlExcel4WorkbookxlExcel5xlExcel7xlExcel9795xlHTMLxlIntlAddInxlIntlMacro
 xlSYLK 
xlTemplatexlTextMacxlTextMSDOSxlTextPrinterxlTextWindowsxlUnicodeTextxlWJ2WD1xlWK1xlWK1ALLxlWK1FMTxlWK3xlWK4xlWK3FM3xlWKSxlWorkbookNormalxlWorks2FarEastxlWQ1xlWJ3xlWJ3FJ3
 

Answer 4

创建Excel,把数据存入Excel
Private Sub ComExport_Click()
    Dim xlApp As New Excel.Application
    Dim xlBook As New Excel.Workbook   '定義Excel工作簿對象
    Dim xlSheet As New Excel.Worksheet '定義Excel工作表對象
    
    Dim line As Integer, M As Integer, n As Integer
    
    Dim savepath As String  '定義保存路徑
    
    CommonDialog1.CancelError = True   '設置cancelError為ture
    
    On Error GoTo errhandler
    CommonDialog1.Flags = cdlOFNHideReadOnly
    
    
    CommonDialog1.FileName = "Report"
    
    CommonDialog1.DefaultExt = ".xls"
    
    CommonDialog1.Filter = "Excel(*.xls)|*.xls|Text(*.txt)|*.txt"
    
    CommonDialog1.FilterIndex = 1
    
    CommonDialog1.Flags = &H2
    
    CommonDialog1.ShowSave
    
    If ERR.Number = cdlCancel Then
    
        Exit Sub
    
    End If
    
    savepath = CommonDialog1.FileName
    
    ''######################以下是匯入到excel
    
     Set xlApp = CreateObject("Excel.Application")
    ' xlApp.Visible = True         '根据操作人是否需見到Excel此處可設TRUE 或FALSE
    xlApp.Visible = False
    
    Set xlBook = xlApp.Workbooks.add
    On Error Resume Next
    Set xlSheet = xlBook.Worksheets(1)
    If k = 2 Then  'by 機台編號
        str_eqid = ""
        n = 0
        M = 1                               '得到的str_eqid 用與excel
        For M = 0 To ListSbbh.ListCount - 1
            If ListSbbh.Selected(M) = True Then
                str_eqid = str_eqid & Trim(ListSbbh.List(M))
                If n < ListSbbh.SelCount Then
                    str_eqid = str_eqid
                End If
                n = n + 1
            End If
        Next M
         xlSheet.Cells(1, 4) = "EQ Down Top10 Report"
        xlSheet.Cells(2, 1) = "Date:"
        xlSheet.Cells(2, 2) = Format(DTPickerStart.Value, "yyyy-mm-dd") & "  07:30:00"
        xlSheet.Cells(2, 3) = "TO"
        xlSheet.Cells(2, 4) = Format(DTPickerEnd.Value + 1, "yyyy-mm-dd") & "  07:30:00"
        xlSheet.Cells(3, 1) = "Eqid:"
        xlSheet.Cells(3, 2) = str_eqid
        
        xlSheet.Cells(4, 1) = "Bug Poenomenon"
        xlSheet.Cells(5, 1) = "Quantity"
        
        rsgzxx.MoveFirst
        
        line = 4
        Do While Not rsgzxx.EOF
            xlSheet.Cells(4, line).Value = rsgzxx("poenomenon").Value
            xlSheet.Cells(5, line).Value = rsgzxx("quantity").Value
            
            line = line + 1
            rsgzxx.MoveNext
        Loop
    End If     xlBook.SaveAs FileName:=savepath, FileFormat:=xlNormal, _
    PassWord:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    xlBook.Saved = True   '保存到Excel
    MsgBox "保存成功！", vbOKOnly, "信息"
    '結束EXcel進程
    xlApp.Quit  '
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    
errhandler:
    
    Exit Sub
    
End Sub

Answer 5

上面的已经很详细了
推荐 用 henrryzhang(North Wolf) 的
保存为excel97格式就行了啊
简单的说就是用
excelapp.saveas , num   num为文件格式
我不知道哪个是excel 97  调试的时候你试一下就知道了
num为以下数字：
16 Microsoft Excel 2.x
29 Microsoft Excel 3.0
33 Microsoft Excel 4.0
35 Microsoft Excel 4.0 工作簿然后再加上马哥的参数就行了xlsWork.Close (True)
有问题再问吧！！！

Answer 6

为什么到处的文件会在savepath存放一个,另外在我的文档下也有一个。可不可以只要一个存放savepath下面

Answer 7

On Error GoTo yang1
Dim I, J, M As Integer
Dim strN, STRtXT As String
Dim recExcel As New Excel.Application
Dim recBook As New Workbook Set recExcel = New Excel.Application
Me.CommonDialog1.Filter = "Text File(*.xls)|*.xls|All Files(*.*)"
Me.CommonDialog1.ShowSave
STRtXT = Me.CommonDialog1.FileName
If STRtXT = "" Then
   Exit Sub
Else
    If Dir$(STRtXT) <> "" Then
       Kill STRtXT
       Call Pwrite("", STRtXT)
       recExcel.Workbooks.Open STRtXT
       Set recBook = recExcel.ActiveWorkbook
     Else
       Call Pwrite("", STRtXT)
       recExcel.Workbooks.Open STRtXT
       Set recBook = recExcel.ActiveWorkbook
    End If
End If
   Me.MousePointer = 11
         
   strN = "select * from gpbg  order by gp_sg  "
  M = RecordCount(strN)
  If M > 0 Then
  I = 1
    If recnHlz.State = adStateOpen Then
       recnHlz.Close
    End If
     recnHlz.Open strN, GP_cn, adOpenDynamic, adLockOptimistic
      recBook.ActiveSheet.Cells(1, 1).Value = "变更前代表品番 "
      recBook.ActiveSheet.Cells(1, 2).Value = "变更后代表品番"
      recBook.ActiveSheet.Cells(1, 3).Value = "变更仕挂"
       recBook.ActiveSheet.Cells(1, 4).Value = "变更项目"
       recBook.ActiveSheet.Cells(1, 5).Value = "适用品番"
       recBook.ActiveSheet.Cells(1, 6).Value = "变更内容"
       '‘recBook.ActiveSheet.Cells(1, 7).Value = "变更后资料"
       recnHlz.MoveFirst
       
      Do While Not recnHlz.EOF
        recBook.ActiveSheet.Cells(I + 1, 1).Value = recnHlz.Fields("gp_qpf")
        recBook.ActiveSheet.Cells(I + 1, 2).Value = recnHlz.Fields("gp_hpf")
        recBook.ActiveSheet.Cells(I + 1, 3).Value = recnHlz.Fields("gp_sg")
        recBook.ActiveSheet.Cells(I + 1, 4).Value = recnHlz.Fields("gp_bgxm")
        recBook.ActiveSheet.Cells(I + 1, 5).Value = recnHlz.Fields("gp_gypf")
        recBook.ActiveSheet.Cells(I + 1, 6).Value = Trim(recnHlz.Fields("gp_bgq")) & " → " & Trim(recnHlz.Fields("gp_bgh"))
         
        Me.Caption = CStr(I) & "/" & CStr(M)
         I = I + 1
        
     recnHlz.MoveNext
     Loop
      
       
      recBook.SaveAs FileName:=STRtXT, FileFormat:=xlNormal, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    recBook.Saved = True
     
     'recBook.Save
     recBook.Close True
    
     Set recBook = Nothing
     
     recExcel.Quit
     Set recExcel = Nothing
     Me.MousePointer = 0
  Else
     MsgBox "没有数据导出", vbOKOnly + vbInformation, "提示信息..."
     Set recBook = Nothing
     recExcel.Quit
     Set recExcel = Nothing
     Exit Sub
  End If
pp:
    Exit Sub
yang1:
     MsgBox "导出数据出错！", vbOKOnly + vbInformation, "提示信息..."
     Set recBook = Nothing
     recExcel.Quit
     Set recExcel = Nothing
     Me.MousePointer = 0
     Resume pp上面是我的代码，现在可以导出数据，但还是会出现Microsoft Excel 提示
提示如下：
 在当前位置发现已经存在该文件,是否替换该文件 <是><否><取消> 
 如果选择是，在我的文档下面有一个文件，另外在STRtXT有一个，我现在不需要两个
 请问怎么解决，谢谢。
 有满意答案就揭贴

Answer 8

On Error GoTo yang1
Dim I, J, M As Integer
Dim strN, STRtXT As String
Dim recExcel As New Excel.Application
Dim recBook As New Workbook Set recExcel = New Excel.Application
Me.CommonDialog1.Filter = "Text File(*.xls)|*.xls|All Files(*.*)"
Me.CommonDialog1.ShowSave
STRtXT = Me.CommonDialog1.FileName
If STRtXT = "" Then
   Exit Sub
Else
    If Dir$(STRtXT) <> "" Then
       Kill STRtXT
       Call Pwrite("", STRtXT)
       recExcel.Workbooks.Open STRtXT
       Set recBook = recExcel.ActiveWorkbook
     Else
       Call Pwrite("", STRtXT)
       recExcel.Workbooks.Open STRtXT
       Set recBook = recExcel.ActiveWorkbook
    End If
End If
   Me.MousePointer = 11
         
   strN = "select * from gpbg  order by gp_sg  "
  M = RecordCount(strN)
  If M > 0 Then
  I = 1
    If recnHlz.State = adStateOpen Then
       recnHlz.Close
    End If
     recnHlz.Open strN, GP_cn, adOpenDynamic, adLockOptimistic
      recBook.ActiveSheet.Cells(1, 1).Value = "变更前代表品番 "
      recBook.ActiveSheet.Cells(1, 2).Value = "变更后代表品番"
      recBook.ActiveSheet.Cells(1, 3).Value = "变更仕挂"
       recBook.ActiveSheet.Cells(1, 4).Value = "变更项目"
       recBook.ActiveSheet.Cells(1, 5).Value = "适用品番"
       recBook.ActiveSheet.Cells(1, 6).Value = "变更内容"
       '‘recBook.ActiveSheet.Cells(1, 7).Value = "变更后资料"
       recnHlz.MoveFirst
       
      Do While Not recnHlz.EOF
        recBook.ActiveSheet.Cells(I + 1, 1).Value = recnHlz.Fields("gp_qpf")
        recBook.ActiveSheet.Cells(I + 1, 2).Value = recnHlz.Fields("gp_hpf")
        recBook.ActiveSheet.Cells(I + 1, 3).Value = recnHlz.Fields("gp_sg")
        recBook.ActiveSheet.Cells(I + 1, 4).Value = recnHlz.Fields("gp_bgxm")
        recBook.ActiveSheet.Cells(I + 1, 5).Value = recnHlz.Fields("gp_gypf")
        recBook.ActiveSheet.Cells(I + 1, 6).Value = Trim(recnHlz.Fields("gp_bgq")) & " → " & Trim(recnHlz.Fields("gp_bgh"))
         
        Me.Caption = CStr(I) & "/" & CStr(M)
         I = I + 1
        
     recnHlz.MoveNext
     Loop
      
       
      recBook.SaveAs FileName:=STRtXT, FileFormat:=xlNormal, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    recBook.Saved = True
     
     'recBook.Save
     recBook.Close True
    
     Set recBook = Nothing
     
     recExcel.Quit
     Set recExcel = Nothing
     Me.MousePointer = 0
  Else
     MsgBox "没有数据导出", vbOKOnly + vbInformation, "提示信息..."
     Set recBook = Nothing
     recExcel.Quit
     Set recExcel = Nothing
     Exit Sub
  End If
pp:
    Exit Sub
yang1:
     MsgBox "导出数据出错！", vbOKOnly + vbInformation, "提示信息..."
     Set recBook = Nothing
     recExcel.Quit
     Set recExcel = Nothing
     Me.MousePointer = 0
     Resume pp