Results 1 to 5 of 5

Thread: Split Closed Workbook into Multiple Workbooks Using ADO

  1. #1
    Junior Member
    Join Date
    Sep 2011
    Posts
    13
    Rep Power
    0

    Split Closed Workbook into Multiple Workbooks Using ADO

    Dear Experts,

    Is there any addin available to split the excel worsheet into multiple work books basis the input file size.

    The main data is avilable in an xlsx work book having 5 lacs rows and 30 MB size. The maximum upload size possible in our internal software is 3 MB
    Now i need to convert this office 2007 to office 2003 with a file sile of less than or exqual to 3 MB.

    I would like to know one more thing also the office 2007 work sheet is having 2 lacs records which wil not get loaded in office 2003 is there any addin avaiable in office 2003 which will open the office 2007 file ----read it -----and copy in multiple work sheet of 65000 rows.

    Thanks in advance

    R.Ramakrishnan

  2. #2
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,401
    Rep Power
    10
    ramakrishnan,

    it is hard to gauge the number of rows required to contribute to a certain file size, but one can do some simple calculations to decide how many rows of data would add up to make the total size.

    In your case, 500000 rows add up to 30MB which means 50000 rows approximately would make up to 3MB.

    There are File format converters OR Compatibility Packs that can convert files saved in newer versions of Office to be opened in older versions.
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  3. #3
    Junior Member
    Join Date
    Sep 2011
    Posts
    13
    Rep Power
    0
    Sir,

    File format convertor is already installed in my pc which is converting the xlsx to xls and open it in the office 2003 module but more than 65000 rows are not imported in the worksheet the challenge is


    Split the data - when office 2007 is not installed but the file needs to be splitted in to multiple files (xls) as per the input value for no of rows. As you suggested we can ignore the size and use no of rows for splitting the xlsx file.

    Is there any addin available in 2003 to do this activity.

    Kindly guide.

    Regards
    R.Ramakrishnan

  4. #4
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,401
    Rep Power
    10
    Have you tried saving the file as csv?
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  5. #5
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Hi Ramakrishnan,

    Try this. Thanks to Ron Debruin

    In a standard module

    Code:
    Public rsCon        As Object
    Public rsData       As Object
    
    Dim arrFields()     As String
    Dim blnFieldStored  As Boolean
    
    Public Sub GetData(SourceFile As Variant, SourceSheet As String, SourceRange As String, _
                        Header As Boolean, UseHeaderRow As Boolean, Fname As String)
        
        'Original code: Ron Debruin
        ' 30-Dec-2007, working in Excel 2000-2007
        Dim szConnect   As String
        Dim szSQL       As String
        Dim lCount      As Long
        Dim wbkActive   As Workbook
        Dim wbkNew      As Workbook
        
        Set wbkActive = ThisWorkbook
        
        ' Create the connection string.
        If Header = False Then
            If Val(Application.Version) < 12 Then
                szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & SourceFile & ";" & _
                            "Extended Properties=""Excel 8.0;HDR=No"";"
            Else
                szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                            "Data Source=" & SourceFile & ";" & _
                            "Extended Properties=""Excel 12.0;HDR=No"";"
            End If
        Else
            If Val(Application.Version) < 12 Then
                szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & SourceFile & ";" & _
                            "Extended Properties=""Excel 8.0;HDR=Yes"";"
            Else
                szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                            "Data Source=" & SourceFile & ";" & _
                            "Extended Properties=""Excel 12.0;HDR=Yes"";"
            End If
        End If
    
        If SourceSheet = "" Then
            ' workbook level name
            szSQL = "SELECT * FROM " & SourceRange$ & ";"
        Else
            ' worksheet level name or range
            szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
        End If
    
        On Error GoTo SomethingWrong
    
        If rsCon Is Nothing Then
            Set rsCon = CreateObject("ADODB.Connection")
            Set rsData = CreateObject("ADODB.Recordset")
        End If
        
        If Not rsCon.State = 1 Then rsCon.Open szConnect
        
        If rsData.State = 1 Then rsData.Close
        rsData.Open szSQL, rsCon, 0, 1, 1
    
        ' Check to make sure we received data and copy the data
        If Not rsData.EOF Then
            Set wbkNew = Workbooks.Add
            If Not blnFieldStored Then
                For i = 1 To rsData.Fields.Count
                    ReDim Preserve arrFields(1 To i)
                    arrFields(i) = rsData.Fields(i - 1).Name
                Next
                blnFieldStored = True
            End If
        
            'Add the header cell in each column if the last argument is True
            With wbkNew.Worksheets(1)
                .Cells(1, 1).Resize(, UBound(arrFields)) = arrFields
                .Cells(2, 1).CopyFromRecordset rsData
            End With
                    
            wbkNew.SaveAs ThisWorkbook.Path & "\" & Fname, 51
            wbkNew.Close
            Set wbkNew = Nothing
        Else
            MsgBox "No records returned from : " & SourceFile, vbCritical
        End If
        
        ' Clean up
        Set wbkActive = Nothing
        Exit Sub
    
    SomethingWrong:
        MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
               vbExclamation, "Error"
        On Error GoTo 0
    
    End Sub
    Again in a standard module. (Better in a new module)

    Code:
    Sub kTest()
        
        Dim i               As Long
        Dim Fname           As String
        Dim n               As Long
        
        Const NewWbkRows    As Long = 40000     '<<==== adjust this rows
        Const TotalRows     As Long = 300000    '<<==== adjust this rows
        
        Const SourceFile    As String = "D:\Temp\Sample.xlsx" '<<==== adjust to suit
        
        
        For i = 1 To TotalRows Step NewWbkRows
            n = n + 1
            If i = 1 Then
                GetData SourceFile, "Sheet1", _
                    "A" & i & ":H" & i + NewWbkRows - 1, True, True, "NewFile" & n
            Else
                GetData SourceFile, "Sheet1", _
                    "A" & i & ":H" & i + NewWbkRows - 1, True, False, "NewFile" & n
            End If
        Next
        
        If rsData.State = 1 Then rsData.Close
        Set rsData = Nothing
        If rsCon.State = 1 Then rsCon.Close
        Set rsCon = Nothing
    
    End Sub
    Adjust the rows and file path.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Split Workbook into Separate Workbooks VBA
    By Admin in forum Download Center
    Replies: 12
    Last Post: 08-08-2018, 09:33 PM
  2. Replies: 2
    Last Post: 05-28-2013, 05:32 PM
  3. Replies: 2
    Last Post: 04-14-2013, 09:15 PM
  4. Replies: 2
    Last Post: 12-19-2012, 08:28 AM
  5. split data into multiple workbooks with 3 conditions.
    By malaionfun in forum Excel Help
    Replies: 5
    Last Post: 05-11-2012, 11:26 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •