Transfer VB? MsFlexgrid1 to an existing excel spreadsheet

Hello VBClassicGuy and thanks for your help.

I have modified the code a bit:

But know, it transfer the first line ok but not the other ones.

But the lines in excel shows up to line 86, and i have 86 lines in my grid.

So know i what to know what should a fix to transfer all data.

Thanks again for your help.

Best regards

Rem *** Get total number of records ***
  TotalRecs& = MSFlexGrid1.Rows - 2
 
   If TotalRecs& = 0 Then
     MsgBox "Zero records to export", vbCritical
  Else
     On Error GoTo GoofedUp
     Rem *** Set up Progress Bar ***
     
     Rem *** Do da Excel magic! ***
     Dim AppExcel As Variant, txt$
     Set AppExcel = CreateObject("Excel.application")
     AppExcel.Visible = False
     AppExcel.Workbooks.Add
     Rem *** Add column headers ***
     For C% = 0 To MSFlexGrid1.Cols - 1
        AppExcel.Cells(1, C% + 1).Font.Bold = True
        AppExcel.Cells(1, C% + 1).Formula = MSFlexGrid1.TextMatrix(0, C%)
        AppExcel.Cells(1, C% + 1).Borders.Weight = 2
     Next C%
     r& = 1
     Rem *** Add data ***
    
     Rem *** Add cell borders ***
     AppExcel.Range("A1:" & Chr$(64 + MSFlexGrid1.Cols) & CStr(TotalRecs& + 1)).Borders.Weight = 1
     Rem *** Resize all columns to width of their content ***
     AppExcel.ActiveSheet.Columns.AutoFit
     Rem *** Set proper column alignment
     For C% = 0 To MSFlexGrid1.Cols - 1
        Select Case MSFlexGrid1.ColAlignment(C%)
           Case 0 To 2 'Left
              a% = 2
           Case 3 To 5 'Center
              a% = 3
           Case 6 To 8 'Right
              a% = 4
           Case Else   'Contents
              a% = 1
        End Select
        AppExcel.ActiveSheet.Columns(Chr$(65 + C%)).HorizontalAlignment = a%
     Next C%
     AppExcel.Visible = True

Select allOpen in new window

Oh by the way, I always add an empty line as the first line of any FlexGrid and set it's height to 15 (makes a nice "dividing line". I'm guessing you, like eveyone else, don't, so change the first line of code from "TotalRecs& = fg.Rows - 2" to "TotalRecs& = fg.Rows - 1".
If the code you just posted is the entire code you're using, you skipped the code under:
Rem *** Add data***
which is why you're not getting all the lines. This code, by the way, calls another function, ParseLine. Here it is:
Function ParseLine$(ByVal txt$, delim$, num%)
   Rem *** Parse line ***
   Do
      d% = InStr(txt$, delim$)
      If d% = 0 Then
         If Found% Then
            If Found% + 1 = num% Then
               p$ = txt$
            Else
               p$ = ""
            End If
         Else
            If num% = 1 Then p$ = txt$
         End If
         Exit Do
      End If
      p$ = Left$(txt$, d% - 1)
      txt$ = Right$(txt$, Len(txt$) - d%)
      Found% = Found% + 1
      If Found% = num% Then Exit Do
   Loop
   ParseLine$ = p$
End Function
 

I have add the code missing.

But still, it does not transfer.

Could it be that on the second rows of the grid, there's noting?

It starts again on the 3rd row.

It's possible...

Is there a way to make it work even if there's nothing in the second row?

I've tried with data in row 2 and still nothing after the 1st row.

Maybe if a row is empty, put spaces in Excel? Like changing:
        For c% = 0 To fg.Cols - 1
           AppExcel.Range(Chr$(65 + c%) & CStr(r&)) = ParseLine$(txt$, vbTab, c% + 1)
        Next c%

to
        For c% = 0 To fg.Cols - 1
           If Len(txt$) Then
              AppExcel.Range(Chr$(65 + c%) & CStr(r&)) = ParseLine$(txt$, vbTab, c% + 1)
            Else
               AppExcel.Range(Chr$(65 + c%) & CStr(r&)) = Space$(1)
            End If
        Next c%
 

I don't see where is that code:

 For c% = 0 To fg.Cols - 1
          AppExcel.Range(Chr$(65 + c%) & CStr(r&)) = ParseLine$(txt$, vbTab, c% + 1)
       Next c%

Function FlexGet$(MSFlexGrid1 As MSFlexGrid, r&)
  If r& < 2 Then r& = MSFlexGrid1.Row
  txt$ = MSFlexGrid1.TextMatrix(r&, 0)
  For C% = 1 To MSFlexGrid1.Cols - 1
     txt$ = txt$ & vbTab & MSFlexGrid1.TextMatrix(r&, C%)
  Next C%
  FlexGet$ = txt$
End Function
Function ParseLine$(ByVal txt$, delim$, num%)
  Rem *** Parse line ***
  Do
     d% = InStr(txt$, delim$)
     If d% = 0 Then
        If found% Then
           If found% + 1 = num% Then
              p$ = txt$
           Else
              p$ = ""
           End If
        Else
           If num% = 1 Then p$ = txt$
        End If
        Exit Do
     End If
     p$ = Left$(txt$, d% - 1)
     txt$ = Right$(txt$, Len(txt$) - d%)
     found% = found% + 1
     If found% = num% Then Exit Do
  Loop
  ParseLine$ = p$
End Function
Private Sub Command4_Click()
  Rem *** Get total number of records ***
  TotalRecs& = MSFlexGrid1.Rows - 1
 
   If TotalRecs& = 0 Then
     MsgBox "Zero records to export", vbCritical
  Else
     On Error GoTo GoofedUp
     
     
     Rem *** Do da Excel magic! ***
     Dim AppExcel As Variant, txt$
     Set AppExcel = CreateObject("Excel.application")
     AppExcel.Visible = False
     AppExcel.Workbooks.Add
     Rem *** Add column headers ***
     For C% = 0 To MSFlexGrid1.Cols - 1
        AppExcel.Cells(1, C% + 1).Font.Bold = True
        AppExcel.Cells(1, C% + 1).Formula = MSFlexGrid1.TextMatrix(0, C%)
        AppExcel.Cells(1, C% + 1).Borders.Weight = 2
     Next C%
     r& = 1
     Rem *** Add data ***
    
     Rem *** Add cell borders ***
     AppExcel.Range("A1:" & Chr$(64 + MSFlexGrid1.Cols) & CStr(TotalRecs& + 1)).Borders.Weight = 2
     Rem *** Resize all columns to width of their content ***
     AppExcel.ActiveSheet.Columns.AutoFit
     Rem *** Set proper column alignment
     For C% = 0 To MSFlexGrid1.Cols - 1
        Select Case MSFlexGrid1.ColAlignment(C%)
           Case 0 To 2 'Left
              A% = 2
           Case 3 To 5 'Center
              A% = 3
           Case 6 To 8 'Right
              A% = 4
           Case Else   'Contents
              A% = 1
        End Select
        AppExcel.ActiveSheet.Columns(Chr$(65 + C%)).HorizontalAlignment = A%
     Next C%
     AppExcel.Visible = True
  End If
 
  
   Exit Sub
GoofedUp:
  If Err.Number >= 1 Then
     MsgBox Err.Description, vbCritical, Err.Number
  End If
End Sub

Select allOpen in new window

I don't know, this code has been working for me for years. Maybe you should start over with my original posted code (just highlight and copy from here, then paste into VB), verify it works, then start modifying from there.
Don't forget to change the "TotalRecs& = fg.Rows - 2" at the top, and include the ParseLine function.

ok i will do this.

Let you know the result after.

Thanks again for your help

OK, know fix.

But i have an issue.

381 out of limits.

That part of the code is creating an issue

Rem *** Add data ***
     While cnt& < TotalRecs&
        r& = r& + 1
        txt$ = FlexGet$(MSFlexGrid1, r&)
        For C% = 0 To MSFlexGrid1.Cols - 1

          If Len(txt$) Then
             AppExcel.Range(Chr$(65 + C%) & CStr(r&)) = ParseLine$(txt$, vbTab, C% + 1)

           Else

              AppExcel.Range(Chr$(65 + C%) & CStr(r&)) = Space$(1)

           End If
       Next C%
        cnt& = cnt& + 1
        
     Wend

Select allOpen in new window

Yes, it works.

I big thanks for your help.

Sounds like a variable is overflowing. As you can see, unlike most other programmers, I use Implicit variable declaration in VB6. The "r&" is a Long, "txt$" is a String, "c%" is an Integer, etc.
You might try "promoting" one or more of the variables to the next level. For instance, "c@" would make the variable c of the Currency type (although I doubt you need this. I can't see you having over 2.1 Gig columns, which is the limit of a Long variable). But you get the point. SOME variable in there is probably overflowing, you just have to experiment and find out which one. My databases are not that big, and that is probably why the code has never failed me.
Good luck!

Oops, looks like we "crossed in the mail".
Glad I could help.