Copy to
El problema es este, yo quiero exportar una tabla de 350,000 registros hacia un archivo de Excel.
Copy to Libro1 type xl5
Pero no me exporta todos los registros solamente exporta 16,383 registros a que se debe.
Copy to Libro1 type xl5
Pero no me exporta todos los registros solamente exporta 16,383 registros a que se debe.
1 Respuesta
Respuesta de alvarocastel
1
Debes usar una funcion que esporte los datos, copy to solo exporta esa cantidad de registros
Muy agradecido por la ganas y paciencia puesta de tu parte para con mi pregunta.
Me podrías enviar una función para tomarlo de ejemplo, por favor te lo agradecería bastante.
La función para pasar 350,000 registros hacia un archivo Excel, ya que el copy to solo manda 16,383
La función para pasar 350,000 registros hacia un archivo Excel, ya que el copy to solo manda 16,383
Aqui te va esta funcion, espero te sirva
****************************
Function ReporteaExcel
Lparameters cTablaEnviar
***************************
cTablaEnviar= Iif(Empty(cTablaEnviar),Alias(),cTablaEnviar)
Select &cTablaEnviar
cOldSafety = Set("Safety")
Set Safety Off
Wait Window Nowait "Por favor espere, enviando datos a Excel..."
lnTotal = Reccount()
oExcel = Createobject("Excel.application")
With oExcel
*.Visible = .T.
oMasterWorkBook = .Workbooks.Add && Add a new workbook
lnMaxRows = .ActiveWorkBook.ActiveSheet.Rows.Count && Get max row count
lnNeededSheets = Ceiling( lnTotal / (lnMaxRows - 1) ) && 1 row header
.Cells(2,1) = WgEmpresa && Una variable que contiene el nombre de la empresa
.Cells(3,1) = _Screen.ActiveForm.Caption && Titulo del formulario
cLetrasAZ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
nCampos = Fcount()
nI1 = Int(nCampos/26)
nI2 = Round(((nCampos/26) - nI1) * 26, 0)
cRangoF = Iif(nI1 > 1, "A", Substr(cLetrasAZ, nI1, 1) + Iif(nI2>0, Substr(cLetrasAZ, nI2, 1), ""))
oExcel.Range("A2:"+ cRangoF+"2").Select
With .Selection
.HorizontalAlignment = -4108
.VerticalAlignment = -4107
.WrapText = .F.
.Orientation = 0
.AddIndent = .F.
.IndentLevel = 0
.ShrinkToFit = .F.
.ReadingOrder = -5002
.MergeCells = .F.
.Merge
.Font.ColorIndex = 3
.Font.Name = 'Tahoma'
.Font.Bold = .T.
.Interior.Pattern = 1
Endwith
oExcel.Range("A3:"+ cRangoF+"3").Select
With .Selection
.HorizontalAlignment = -4108
.VerticalAlignment = -4107
.WrapText = .F.
.Orientation = 0
.AddIndent = .F.
.IndentLevel = 0
.ShrinkToFit = .F.
.ReadingOrder = -5002
.MergeCells = .F.
.Merge
.Font.ColorIndex = 3
.Font.Name = 'Tahoma'
.Font.Bold = .T.
.Interior.Pattern = 1
Endwith
For nColumn =1 To nCampos
oExcel.Cells(5,nColumn) = (Field(nColumn))
Next
oExcel.Range("A5:"+ cRangoF+"5").Select
With .Selection
.Interior.ColorIndex = 37
.Interior.Pattern = 1
.Font.Name = 'Tahoma'
.Font.Bold = .T.
.Font.Size = 10
Endwith
lnCurrentSheetCount = .sheets.Count
If lnNeededSheets > lnCurrentSheetCount
.sheets.Add(,.sheets(lnCurrentSheetCount),;
lnNeededSheets - lnCurrentSheetCount) && Add new sheets after old ones
Endif
Endwith
With oMasterWorkBook
For ix = 1 To lnNeededSheets
.sheets.Item(ix).Name = "Page "+Padl(ix,3,"0")
Endfor
lcExportName = Sys(5)+Curdir()+Sys(2015)+".dbf"
For ix = 1 To lnNeededSheets
lnStart = ( ix - 1 ) * (lnMaxRows-1) + 1
Copy To (lcExportName) For Between(Recno(),lnStart,lnStart+lnMaxRows-2);
Type Fox2x
oSourceWorkBook = oExcel.Workbooks.Open(lcExportName)
.Worksheets(ix).Activate
oSourceWorkBook.Worksheets(1).UsedRange.Copy(;
.Worksheets(ix).Range('A6'))
oSourceWorkBook.Close(.F.) && Close w/o save
Erase (lcExportName)
Endfor
oExcel.Range("6:6").Select
oExcel.Selection.Delete(-4162)
.Worksheets(1).Activate
Endwith
oExcel.Visible = .T.
Wait Clear
Set Safety &cOldSafety
****************************
Function ReporteaExcel
Lparameters cTablaEnviar
***************************
cTablaEnviar= Iif(Empty(cTablaEnviar),Alias(),cTablaEnviar)
Select &cTablaEnviar
cOldSafety = Set("Safety")
Set Safety Off
Wait Window Nowait "Por favor espere, enviando datos a Excel..."
lnTotal = Reccount()
oExcel = Createobject("Excel.application")
With oExcel
*.Visible = .T.
oMasterWorkBook = .Workbooks.Add && Add a new workbook
lnMaxRows = .ActiveWorkBook.ActiveSheet.Rows.Count && Get max row count
lnNeededSheets = Ceiling( lnTotal / (lnMaxRows - 1) ) && 1 row header
.Cells(2,1) = WgEmpresa && Una variable que contiene el nombre de la empresa
.Cells(3,1) = _Screen.ActiveForm.Caption && Titulo del formulario
cLetrasAZ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
nCampos = Fcount()
nI1 = Int(nCampos/26)
nI2 = Round(((nCampos/26) - nI1) * 26, 0)
cRangoF = Iif(nI1 > 1, "A", Substr(cLetrasAZ, nI1, 1) + Iif(nI2>0, Substr(cLetrasAZ, nI2, 1), ""))
oExcel.Range("A2:"+ cRangoF+"2").Select
With .Selection
.HorizontalAlignment = -4108
.VerticalAlignment = -4107
.WrapText = .F.
.Orientation = 0
.AddIndent = .F.
.IndentLevel = 0
.ShrinkToFit = .F.
.ReadingOrder = -5002
.MergeCells = .F.
.Merge
.Font.ColorIndex = 3
.Font.Name = 'Tahoma'
.Font.Bold = .T.
.Interior.Pattern = 1
Endwith
oExcel.Range("A3:"+ cRangoF+"3").Select
With .Selection
.HorizontalAlignment = -4108
.VerticalAlignment = -4107
.WrapText = .F.
.Orientation = 0
.AddIndent = .F.
.IndentLevel = 0
.ShrinkToFit = .F.
.ReadingOrder = -5002
.MergeCells = .F.
.Merge
.Font.ColorIndex = 3
.Font.Name = 'Tahoma'
.Font.Bold = .T.
.Interior.Pattern = 1
Endwith
For nColumn =1 To nCampos
oExcel.Cells(5,nColumn) = (Field(nColumn))
Next
oExcel.Range("A5:"+ cRangoF+"5").Select
With .Selection
.Interior.ColorIndex = 37
.Interior.Pattern = 1
.Font.Name = 'Tahoma'
.Font.Bold = .T.
.Font.Size = 10
Endwith
lnCurrentSheetCount = .sheets.Count
If lnNeededSheets > lnCurrentSheetCount
.sheets.Add(,.sheets(lnCurrentSheetCount),;
lnNeededSheets - lnCurrentSheetCount) && Add new sheets after old ones
Endif
Endwith
With oMasterWorkBook
For ix = 1 To lnNeededSheets
.sheets.Item(ix).Name = "Page "+Padl(ix,3,"0")
Endfor
lcExportName = Sys(5)+Curdir()+Sys(2015)+".dbf"
For ix = 1 To lnNeededSheets
lnStart = ( ix - 1 ) * (lnMaxRows-1) + 1
Copy To (lcExportName) For Between(Recno(),lnStart,lnStart+lnMaxRows-2);
Type Fox2x
oSourceWorkBook = oExcel.Workbooks.Open(lcExportName)
.Worksheets(ix).Activate
oSourceWorkBook.Worksheets(1).UsedRange.Copy(;
.Worksheets(ix).Range('A6'))
oSourceWorkBook.Close(.F.) && Close w/o save
Erase (lcExportName)
Endfor
oExcel.Range("6:6").Select
oExcel.Selection.Delete(-4162)
.Worksheets(1).Activate
Endwith
oExcel.Visible = .T.
Wait Clear
Set Safety &cOldSafety
