SQL導出到Excel循環中缺少前導零

Question

新的VB程序員在這里。 我正在使用以下方法將SQL表導出到Excel文件。 但是，當我在excel中創建文件時，主鍵的前導零丟失了，因為它們被轉換為數字而不是文本。 這是由於信息來自數據表到excel。 我想知道如何才能保持我的領先零。

僅供參考-我的主鍵是6位數字，只有少數數字的開頭缺少單個0。 在第一列之后，有許多其他列和行被放入excel文件，它們都可以正常工作。 這只是我需要以某種方式更改格式的第一列主鍵。

另外，我正在使用此excel文件將其上傳到SQL，並且某些主鍵上缺少的0使我的程序創建了一條新記錄。

我以為主要的變化可能會在這里發生，但我不知道該怎么做：

                'Export the Columns to excel file
                For Each dc In datatableMain.Columns
                    colIndex = colIndex + 1
                    oSheet.Cells(1, colIndex) = dc.ColumnName
                Next

                For Each dr In datatableMain.Rows
                    rowIndex = rowIndex + 1
                    colIndex = 1

                    For Each dc In datatableMain.Columns
                        colIndex = colIndex + 1
                        oSheet.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
                    Next
                Next

完整代碼如下：

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

        Dim dataAdapter As New SqlClient.SqlDataAdapter()
        Dim dataSet As New DataSet
        Dim command As New SqlClient.SqlCommand
        Dim datatableMain As New System.Data.DataTable()
        Dim connection As New SqlClient.SqlConnection


        connection.ConnectionString = "Server=myserver;Database=mydatabase;User Id=xxxx;Password=xxxxx"
        command.Connection = connection
        command.CommandType = CommandType.Text
        'You can use any command select
        command.CommandText = "Select * from MYTABLE"
        dataAdapter.SelectCommand = command


        Dim f As FolderBrowserDialog = New FolderBrowserDialog
        Try
            If f.ShowDialog() = DialogResult.OK Then
                'This section help you if your language is not English.
                System.Threading.Thread.CurrentThread.CurrentCulture = _
                System.Globalization.CultureInfo.CreateSpecificCulture("en-US")
                Dim oExcel As Excel.Application
                Dim oBook As Excel.Workbook
                Dim oSheet As Excel.Worksheet
                oExcel = CreateObject("Excel.Application")
                oBook = oExcel.Workbooks.Add(Type.Missing)
                oSheet = oBook.Worksheets(1)

                Dim dc As System.Data.DataColumn
                Dim dr As System.Data.DataRow
                Dim colIndex As Integer = 0
                Dim rowIndex As Integer = 0

                'Fill data to datatable
                connection.Open()

                dataAdapter.Fill(datatableMain)
                connection.Close()

                'Export the Columns to excel file
                For Each dc In datatableMain.Columns
                    colIndex = colIndex + 1
                    oSheet.Cells(1, colIndex) = dc.ColumnName
                Next

                For Each dr In datatableMain.Rows
                    rowIndex = rowIndex + 1
                    colIndex = 1

                    For Each dc In datatableMain.Columns
                        colIndex = colIndex + 1
                        oSheet.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
                    Next
                Next

                'Set final path
                Dim fileName As String = "\" + fname.Text + ".xlsx"
                Dim finalPath = f.SelectedPath + fileName
                txtPath.Text = finalPath
                oSheet.Columns.AutoFit()
                'Save file in final path
                oBook.SaveAs(finalPath, Excel.XlFileFormat.xlOpenXMLWorkbook, Type.Missing, _
                Type.Missing, Type.Missing, Type.Missing, Excel.XlSaveAsAccessMode.xlExclusive, _
                Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing)

                'Release the objects
                ReleaseObject(oSheet)
                oBook.Close(False, Type.Missing, Type.Missing)
                ReleaseObject(oBook)
                oExcel.Quit()
                ReleaseObject(oExcel)
                'Some time Office application does not quit after automation: 
                'so i am calling GC.Collect method.
                GC.Collect()

                MessageBox.Show("Exported!")

            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Warning", MessageBoxButtons.OK)
        End Try
    End If
End Sub
Private Sub ReleaseObject(ByVal o As Object)
    Try
        While (System.Runtime.InteropServices.Marshal.ReleaseComObject(o) > 0)
        End While
    Catch
    Finally
        o = Nothing
    End Try
End Sub

Answer 1

實際上，我大約在10分鍾前遇到了類似的問題！ 我需要從一本書到另一本書獲得30左右的數字，這使所有內容都泛濫成災。 在寫入單元格之前，請嘗試設置列的格式。 我的代碼是Worksheets(i).Range("D:D").NumberFormat = "@"這將告訴Excel“按原樣”對數據進行Worksheets(i).Range("D:D").NumberFormat = "@"而不是嘗試猜測您想要的內容。

Answer 2

我發現了這個問題，希望在我擁有的通用函數中解決同一問題，該函數已由我創建的幾個程序使用。 由於數據源種類繁多，我無法硬編碼設置NumberFormat列。 為了解決這個問題，我利用了循環，我必須輸出列標題。 下面的代碼供那些需要更多動態解決方案的用戶使用。 注意，在同一解決方案中，有幾個對“ EL”的引用，它們是一個自定義錯誤記錄對象的實例，可以被忽略/修改：

''' <summary>
''' Function to take a data table and output its contents to an Excel spreadsheet. Returns a string with any errors (Nothing if successful)
''' </summary>
''' <param name="D">The datatable to be output</param>
''' <param name="epath">The full file path to log errors to</param>
''' <param name="SAName">The full file path to save the created Excel workbook to</param>
''' <param name="Parent">The function calling for data to be output</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function ResOut(ByVal D As DataTable, ByVal epath As String, ByVal SAName As String, ByVal Parent As String) As String
    '
    Dim res As String = ""
    Dim E As New Microsoft.Office.Interop.Excel.Application
    Dim wb As Microsoft.Office.Interop.Excel.Workbook = Nothing
    Dim ws As Microsoft.Office.Interop.Excel.Worksheet = Nothing
    Dim x As Long = 0
    Dim f As Long = 1
    Dim Rng As Microsoft.Office.Interop.Excel.Range = Nothing
    Dim q As String
    Dim Str_Columns As New List(Of String) 'Holds the list of column letters that need forced to Text format in order to retain leading zeroes in the data 
    'that will be placed there
    'Check that the passed in table has data
    If D.Rows.Count = 0 Then
        res = "No data was returned by " & Parent
    End If

    If res = "" Then
        'Create a workbook for the data and capture the workbook and sheet for ease of reference
        Try
            wb = E.Workbooks.Add
            ws = wb.Worksheets(1)

            'Define the range
            q = ColNumToStr(D.Columns.Count, epath)
            Rng = ws.Range("A2:" & q & D.Rows.Count + 1)
        Catch ex As Exception
            res = "Encountered an error while creating the new workbook to export the results to. No data can be returned."
            EL.AddErr(res & " ResOut was called by " & Parent & ". Error Details: " & ex.Message, epath)
        End Try

        'Fill in headers
        If res = "" Then
            Try
                For Each c As DataColumn In D.Columns
                    ws.Range("A1").Offset(0, x).Value = c.ColumnName
                    x = x + 1
                Next
            Catch ex As Exception
                res = "Encountered an error while filling in the column headers. This will prevent any data from being returned."
                EL.AddErr(res & " ResOut was called by " & Parent & ". Error Details: " & ex.Message, epath)
            End Try
        End If

        'Setup the step & frequency for the Step Progress bar
        'Dim t() As Long = s.StatSetup(QR.Rows.Count, 58, "Query Runner\ResOut\" & QName, Replace(My.Settings.EPath, "<user>", Environment.UserName) & DStamp() & " Query Scheduler Log.txt")
        'f = t(0)
        'SProg.Step = t(1)

        'Create the array
        Dim OArr(D.Rows.Count, x) As Object

        'Convert the datatable to a 2D array
        If res = "" Then
            Try
                'Fill it
                x = 0
                For r As Long = 0 To D.Rows.Count - 1 Step 1
                    Dim dr As DataRow = D.Rows(r)

                    For c As Integer = 0 To D.Columns.Count - 1 Step 1
                        OArr(r, c) = dr.Item(c).ToString

                        'Check if this item is a # with leading zeroes (making sure we haven't already added the column to the list of such columns)
                        If Not (Str_Columns.Contains(ColNumToStr(c + 1, epath))) And Strings.Left(dr.Item(c), 1) = "0" Then
                            Str_Columns.Add(ColNumToStr(c + 1, epath))
                        End If 'else the column is in the list already or the item does not dictate it's inclusion
                    Next
                    x = x + 1
                Next
            Catch ex As Exception
                res = "Encountered an error while outputing the " & x + 1 & "-th record of " & D.Rows.Count & ". No data will be output."
                EL.AddErr(res & " ResOut was called by " & Parent & ". Error Details: " & ex.Message, epath)
            End Try
        End If

        'output the array to the target range
        If res = "" Then
            'First force Text format where needed to retain leading zeroes
            Try
                For Each c As String In Str_Columns
                    q = c
                    ws.Range(c & ":" & c).NumberFormat = "@"
                Next
            Catch ex As Exception
                res = "Encountered an error while changing column " & q & " to TEXT in order to retain leading zeroes in the " & ws.Range(q & 1).Value & "data."
                E.Visible = True
                wb.Activate()
                EL.AddErr(res & " ResOut was called by " & Parent & ". Error Details: " & ex.Message & Chr(10) & Chr(10) & "Inner Exception: " & ex.InnerException.Message _
                          , epath)
            End Try

            Try
                Rng.Value = OArr

                'Save the workbook
                wb.SaveAs(SAName)
                wb.Close(SaveChanges:=False)
            Catch ex As Exception
                res = "Encountered an error during the export of the results. Some data may have been exported. Review the contents of the Excel workbook that will " _
                    & "be visible following this message for more details."
                E.Visible = True
                wb.Activate()
                EL.AddErr(res & " ResOut was called by " & Parent & ". Error Details: " & ex.Message, epath)
            End Try
        Else
            'Close the workbook without saving
            wb.Close(SaveChanges:=False)
        End If

        'Cleanup the application
        Try
            E.Quit()
            System.Runtime.InteropServices.Marshal.ReleaseComObject(E)
            E = Nothing
            wb = Nothing
            ws = Nothing
            Rng = Nothing
            OArr = Nothing
            f = Nothing
            x = Nothing
        Catch ex As Exception
            EL.AddErr("Encountered an error while cleaning up the resources used in JMLib\ResOut. ResOut was called by " & Parent & ". Error Details: " & ex.Message, epath)
        End Try
    End If

    Return res
End Function