如何把vb中的data放到一已知目錄的excel,然後將excel另存到user想要的目錄中,很easy

Question

1.如何把vb中的data放到一已知目錄的excel,vb中要怎麼做可以找到特定目錄的excel,dada放到excel中的部分我知道
2.然後將excel另存到user想要的目錄中
就這兩部分的代碼,thanks

Answer 1

第2個問題'請你自己加個CommonDialog控件Private Sub Command3_Click()
    Dim objFileSystem As Object
    Dim objExcelText As Object
    Dim strTableString As String, i As Integer, strFileName As String
    Dim pubConn As New ADODB.Connection
    Dim rsTable As New ADODB.Recordset
    Dim strConn As String
    Dim strSQL As String    strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=develop; password=12345;Data Source=ServerNmae"
    pubConn.Open strConn
    rsTable.CursorLocation = adUseClient
    strSQL = "select top 10 * from gate_register"
    rsTable.Open strSQL, pubConn, adOpenDynamic, adLockOptimistic
    
    For i = 0 To rsTable.Fields.Count - 1
        strTableString = strTableString & rsTable.Fields(i).Name & Chr(9)  '獲取字段名
    Next
    strTableString = strTableString & rsTable.GetString     '字段名+數據庫的記錄
    
    cmDialog.CancelError = False
    cmDialog.FileName = "FileName"  '默認生成的文件名
    cmDialog.DialogTitle = "Save Export File"
    cmDialog.Filter = "Excel (*.xls)|*.xls|文本文件(*.DBF)|*.DBF|檔案文件(*.doc)|*.doc|所有文件(*.*)|*.*"
    cmDialog.DefaultExt = "*.xls"
    cmDialog.ShowSave
    strFileName = cmDialog.FileName
    
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objExcelText = objFileSystem.createtextfile(strFileName, True)
    objExcelText.writeline (strTableString)
    
    objExcelText.Close
    Set objFileSystem = Nothing
End Sub

Answer 2

第一個問題的解決方法，請參考
Private Sub PrintButton_Click()
On Error GoTo ErrHandle
    Dim xlApp As New Excel.Application
    Dim xlBook As New Excel.Workbook
    Dim xlSheet As New Excel.Worksheet
    Dim strsql As String
    Dim rsPict As New ADODB.Recordset
    
    If RichTextBox1.Text = "" Then
        MsgBox "¨S¦³¿é¤J¤u¸¹¡M¨C¦¸¥i¿é¤J9¤H¤u¸¹", vbExclamation, "´£¿ô±z"
        Exit Sub
    End If
    
    Screen.MousePointer = 11
    strsql = "SELECT A.person_no,A.person_name,B.dept_name,A.photo" & _
            " FROM person A LEFT JOIN (SELECT position.position_no,position.name,position.dept_no,dept.name AS dept_name FROM position LEFT JOIN dept ON left(position.dept_no,1)+'0000'=dept.dept_no)B" & _
            " ON A.position_no=B.position_no " & _
            " where A.photo is not null and A.enable='1' and A.person_no in(" & RichTextBox1.Text & ")"
            
    rsPict.Open strsql, pubConn, 1, 1
    If rsPict.EOF Then
        Exit Sub
    End If
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("\\SWEB\Excel\PrintPhoto.xls")
    Set xlSheet = xlBook.Worksheets(2)
    xlApp.Visible = False    rsPict.MoveFirst
    Dim ZX As Single, ZY As Single
    Dim i As Integer, j As Integer
    
    With Image1
        .Stretch = False
        .Visible = False
        .Picture = LoadPicture("\\SWEB\datafile\photo\employee\24115.jpg")
        ZX = .Width / 3000     '°²³]¥Ø¼Ð¼e«×155¹Ï¤¸
        ZY = .Height / 3500    '°²³]¥Ø¼Ð°ª«×165¹Ï¤¸       .Stretch = True
       .Height = Int(.Height / ZY)
       .Width = Int(.Width / ZX)
    End With
    
    i = 0
    j = 0
    Do While Not rsPict.EOF
        xlSheet.Shapes.AddPicture rsPict.Fields(3).Value, False, True, X1(i), Y1(j), ZX * 32, ZY * 37
        xlSheet.Shapes.AddPicture "\\SWEB\datafile\photo\employee\logo.jpg", False, True, X2(i), Y2(j), ZX * 15, ZY * 8
        
        xlSheet.Cells(X3(i), Y3(i)) = AddSpace(rsPict.Fields(2).Value)
        xlSheet.Cells(X3(i) + 2, Y3(i)) = Space(5) & "¤u¸¹:" & rsPict.Fields(0).Value
        xlSheet.Cells(X3(i) + 3, Y3(i)) = Space(5) & "©m¦W:" & IIf(Len(rsPict.Fields(1).Value) = 2, Left(rsPict.Fields(1).Value, 1) + Space(2) + Right(rsPict.Fields(1).Value, 1), rsPict.Fields(1).Value)
        rsPict.MoveNext
        i = i + 1
        j = j + 1
    Loop
    
    xlSheet.Cells(1, 1).Select
    xlApp.Visible = True
    
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Screen.MousePointer = 0
    
    Exit Sub
ErrHandle:
    MsgBox "µo¥Í·N¥~¿ù»~,½Ð¬d¬Ý¿é¤Jªº¤u¸¹¬O§_¥¿½T¡S", vbExclamation, "´£¿ô±z"
    Screen.MousePointer = 0
    
End Sub

Answer 3

既然你会把数据放到EXCEL文件，那你应该知道BOOK对象可以SAVEAS的。