Te pego un modulo de una aplicación, es muy particular pero ves como
actualizo, borro y mandos comando fox via ado.
Saludos
Daniel
Option Explicit
Private cnn As ADODB.Connection
Public Function ClasificarChequesBanco(mp As SJEParametros, cheques As
Collection, Optional pb As ProgressBar) As Dictionary
Dim cBancos As New Dictionary
Dim cChqs As New Collection
Dim chq As cheque
On Error GoTo myError
If cheques.Count > 0 Then
If Not pb Is Nothing Then pb.Max = cheques.Count
End If
For Each chq In cheques
If Not cBancos.Exists("B" & chq.Banco.Nro) Then _
cBancos.Add "B" & chq.Banco.Nro, New Collection
Set cChqs = cBancos.Item("B" & chq.Banco.Nro)
cChqs.Add chq
If Not pb Is Nothing Then _
pb.value = 1
Next
Set ClasificarChequesBanco = cBancos
myError:
If Err <> 0 Then
Set ClasificarChequesBanco = Nothing
Set cBancos = Nothing
Set cChqs = Nothing
Set chq = Nothing
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile,
Err.HelpContext
End If
End Function
Public Function GenerarPreaviso(mp As SJEParametros, dicCheques As
Dictionary, Optional pb As ProgressBar) As Boolean
Dim i As Long
Dim f As Long
Dim av As Long
'FIXIT: Declare 's' con un tipo de datos de enlace en tiempo de
compilación FixIT90210ae-R1672-R1B8ZE
Dim s As Variant
Dim col As Collection
Dim c As cheque
Dim fh As Long
Dim myFile As String
Dim myFileFree As String
Dim fso As New FileSystemObject
Dim resumen As Dictionary
Dim cheque As SJEReporteResumen
Dim b As Banco
Dim Moneda As String
On Error GoTo ExitSecuence
GenerarPreaviso = True
For Each s In dicCheques.Keys
Set col = dicCheques.Item(s)
f = 0
i = 0
Set resumen = New Dictionary
Set b = GetBancoObj(mp, Mid$((s), 2))
For Each c In col
If i = 0 Then
f = f + 1
fh = FreeFile
myFileFree = "SJE-" & Format$(mp.Desde, "YYMMDD") & _
"-" & Format$(mp.Hasta, "YYMMDD") & _
"-BANCO" & Format$(Mid$(s, 2), "000") & _
"-PARTE" & Format$(f, "000") & _
".TXT"
myFile = mp.PathDestino & "\" & myFileFree
If Not fso.FolderExists(mp.PathDestino) Then
MsgBox "La ruta de acceso para guardar el reporte no
existe.", vbCritical, "Aviso al usuario"
GoTo ExitSecuence
End If
If fso.FileExists(myFile) Then
If MsgBox("El reporte ya existe, quiere Usted
sobreescribirlo?", vbQuestion + vbYesNo + vbDefaultButton2, "Aviso al
usuario") = vbNo Then
MsgBox "El reporte ya existe. El mismo no se
generará nuevamente.", vbCritical, "Aviso al usuario"
GenerarPreaviso = False
GoTo ExitSecuence
End If
End If
If f = 1 Then
If fso.FileExists(myFile) Then Kill Replace(myFile,
"PARTE" & Format$(f, "000"), "*")
End If
Open myFile For Append As #fh
Print #fh, ":20:JUB.ARGENTINA"
End If
Select Case mp.MonedaCodificación
Case CodificationConstant.sjeNone
Moneda = ""
Case CodificationConstant.sjeSJE
Moneda = c.Moneda.SJECod
Case CodificationConstant.sjeSWIFT
Moneda = c.Moneda.SWIFTCod
End Select
Print #fh, " :21:" & c.Numero
Print #fh, " :30:" & FmtDate(c.Emision, mp.FechaFormato)
Print #fh, " :32B:" & Moneda & FmtCurrency(c.MontoMLq,
mp.MonedaFormato)
Print #fh, " :59:" & c.Beneficiario.Nombre
If Not resumen.Exists(c.Periodo & c.Moneda.Denominacion) Then
Set cheque = New SJEReporteResumen
resumen.Add c.Periodo & c.Moneda.Denominacion, cheque
End If
Set cheque = resumen.Item(c.Periodo & c.Moneda.Denominacion)
cheque.MesAnio = c.Periodo
cheque.ValorLocal = cheque.ValorLocal + c.MontoMLc
cheque.ValorLiquidacion = cheque.ValorLiquidacion + c.MontoMLq
cheque.MonedaLiquidacion = c.Moneda.SWIFTCod
cheque.Cantidad = cheque.Cantidad + 1
av = av + 1
pb.value = av
i = i + 1
If i = 8 Then
Close #fh
i = 0
End If
Next
Close
ImprimeReporteResumen resumen, "Período de reporte desde el " &
Format$(mp.Desde, "short date") & " hasta el " & Format$(mp.Hasta, "short
date") & _
"|BANCO: " & Trim$(b.Nombre) & "|CIUDAD: " & Trim$(
b.Ciudad) & "||El archivo de salida se creo como: |" & myFileFree & "|En la
carpeta:|" & mp.PathDestino
Next
ExitSecuence:
Close
Set col = Nothing
Set b = Nothing
Set fso = Nothing
Set c = Nothing
If Err Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile,
Err.HelpContext
GenerarPreaviso = False
End If
End Function
Public Function GetCheques(mp As SJEParametros) As ADODB.Recordset
Dim chqRS As New ADODB.Recordset
Dim i As Long
Dim bancos As String
For i = LBound(Split(mp.bancos, ";")) To UBound(Split(mp.bancos, ";"))
bancos = bancos & IIf(bancos <> "", " or ", "") & "Banco=" & Split(
mp.bancos, ";")(i)
Next
If bancos <> "" Then bancos = " and (" & bancos & ")"
chqRS.Open "select * from SJEA120 where dtos(FEMIS)>= '" & Format$(
mp.Desde, "YYYYMMDD") & "' and dtos(FEMIS)<= '" & Format$(mp.Hasta,
"YYYYMMDD") & "' " & bancos, GetADOCnn(mp), adOpenStatic, adLockOptimistic
Set GetCheques = chqRS
Set chqRS = Nothing
End Function
Public Function GetChequesCollection(mp As SJEParametros, Optional excluidos
As Boolean = False, Optional pb As ProgressBar, Optional TodosLosBancos As
Boolean = True) As Collection
Dim chqRS As New ADODB.Recordset
Dim i As Long
Dim bancos As String
Dim c As New Collection
Dim chq As cheque
If Not TodosLosBancos Then
For i = LBound(Split(mp.bancos, ";")) To UBound(Split(mp.bancos,
";"))
bancos = bancos & IIf(bancos <> "", " or ", "") & "Banco=" &
Split(mp.bancos, ";")(i)
Next
If bancos <> "" Then bancos = " and (" & bancos & ")"
Else
bancos = ""
End If
If Not excluidos Then
chqRS.Open "select * from SJEA120 where dtos(FEMIS)>= '" & Format$(
mp.Desde, "YYYYMMDD") & "' and dtos(FEMIS)<= '" & Format$(mp.Hasta,
"YYYYMMDD") & "' " & bancos, GetADOCnn(mp), adOpenStatic, adLockOptimistic
Else
chqRS.Open "select * from SJEA120Excluidos where dtos(FEMIS)>= '" &
Format$(mp.Desde, "YYYYMMDD") & "' and dtos(FEMIS)<= '" & Format$(mp.Hasta,
"YYYYMMDD") & "' " & bancos, GetADOCnn(mp), adOpenStatic, adLockOptimistic
End If
pb.value = pb.Min
If (Not chqRS.EOF) And (Not pb Is Nothing) Then pb.Max =
chqRS.RecordCount
i = 0
While Not chqRS.EOF
Set chq = New cheque
chq.Operacion = chqRS.Fields("nroopp").value
chq.Numero = chqRS.Fields("NROCHEQUE").value
Set chq.Moneda = GetMonedaObj(mp, chqRS.Fields("MON").value)
chq.MontoMLc = chqRS.Fields("IMPNETO").value
chq.MontoMLq = chqRS.Fields("IMPLIQ").value
chq.Cotizacion = chqRS.Fields("COTIZ").value
chq.Emision = chqRS.Fields("FEMIS").value
chq.Periodo = "" & chqRS.Fields("ANO").value & "/" & Format$(
chqRS.Fields("MES").value, "00")
Set chq.Banco = GetBancoObj(mp, chqRS.Fields("Banco").value)
Set chq.Beneficiario = GetBeneficiarioOBJ(mp, chqRS.Fields
("NROJUB").value)
c.Add chq, "Op" & chq.Operacion
i = i + 1
If Not pb Is Nothing Then pb.value = i
DoEvents
chqRS.MoveNext
Wend
chqRS.Close
Set GetChequesCollection = c
Set c = Nothing
Set chqRS = Nothing
End Function
Public Function IncluirCheque(mp As SJEParametros, chq As cheque) As Boolean
Dim chqRS As New ADODB.Recordset
On Error GoTo myError
FreeADOCnn
chqRS.Open "USE SJEA120Excluidos exclusive", GetADOCnn(mp),
adOpenKeyset, adLockOptimistic
chqRS.Filter = "NROopp=" & chq.Operacion
chqRS.Delete
GetADOCnn(mp).Execute "PACK"
chqRS.Close
Set chqRS = Nothing
IncluirCheque = True
Exit Function
myError:
MsgBox "Se ha encontrado el siguiente error: " & Err.Number & " - " &
Err.Description & vbCrLf _
& "La operación no será llevada a cabo.", vbCritical, "Aviso al
usuario"
On Error Resume Next
If chqRS.State = adStateOpen Then
If Not chqRS.EditMode = adEditNone Then chqRS.CancelUpdate
chqRS.Close
End If
Set chqRS = Nothing
IncluirCheque = False
End Function
Public Function ExcluirCheque(mp As SJEParametros, chq As cheque) As Boolean
Dim chqRS As New ADODB.Recordset
On Error GoTo myError
FreeADOCnn
chqRS.Open "USE SJEA120Excluidos SHARED", GetADOCnn(mp), adOpenKeyset,
adLockOptimistic
chqRS.AddNew
chqRS.Fields("nroopp").value = chq.Operacion
chqRS.Fields("NROCHEQUE").value = chq.Numero
chqRS.Fields("MON").value = chq.Moneda.SJECod
chqRS.Fields("IMPNETO").value = chq.MontoMLc
chqRS.Fields("IMPLIQ").value = chq.MontoMLq
chqRS.Fields("COTIZ").value = chq.Cotizacion
chqRS.Fields("FEMIS").value = chq.Emision
chqRS.Fields("ANO").value = Split(chq.Periodo, "/")(0)
chqRS.Fields("MES").value = Split(chq.Periodo, "/")(1)
chqRS.Fields("Banco").value = chq.Banco.Nro
chqRS.Fields("NROJUB").value = chq.Beneficiario.Numero
chqRS.Update
chqRS.Close
Set chqRS = Nothing
ExcluirCheque = True
Exit Function
myError:
MsgBox "Se ha encontrado el siguiente error: " & Err.Number & " - " &
Err.Description & vbCrLf _
& "La operación no será llevada a cabo.", vbCritical, "Aviso al
usuario"
On Error Resume Next
If chqRS.State = adStateOpen Then
If Not chqRS.EditMode = adEditNone Then chqRS.CancelUpdate
chqRS.Close
End If
Set chqRS = Nothing
ExcluirCheque = False
End Function
Public Function GetBancos(mp As SJEParametros) As Collection
Dim xRs As New ADODB.Recordset
Dim c As New Collection
Dim b As Banco
xRs.Open "select Banco,Nombre, Loc from SJEA003 ", GetADOCnn(mp),
adOpenStatic, adLockOptimistic
While Not xRs.EOF
Set b = New Banco
b.Nro = "" & xRs.Fields("Banco").value
b.Nombre = "" & xRs.Fields("Nombre").value
b.Ciudad = "" & xRs.Fields("Loc").value
c.Add b
xRs.MoveNext
Wend
xRs.Close
Set GetBancos = c
Set xRs = Nothing
Set c = Nothing
End Function
Public Function GetBancoObj(mp As SJEParametros, CodBanco As String) As
Banco
Dim xRs As New ADODB.Recordset
Dim b As Banco
xRs.Open "select Nombre, Loc from SJEA003 where Banco=" & CodBanco & "",
GetADOCnn(mp), adOpenStatic, adLockOptimistic
If Not xRs.EOF Then
Set b = New Banco
b.Nombre = "" & xRs.Fields("Nombre").value
b.Ciudad = "" & xRs.Fields("Loc").value
b.Nro = CLng(CodBanco)
Set GetBancoObj = b
Else
Set GetBancoObj = Nothing
End If
xRs.Close
Set b = Nothing
Set xRs = Nothing
End Function
Public Function GetBanco(mp As SJEParametros, CodBanco As String, Nombre As
String, Ciudad As String) As Boolean
Dim xRs As New ADODB.Recordset
xRs.Open "select Nombre, Loc from SJEA003 where Banco=" & CodBanco & "",
GetADOCnn(mp), adOpenStatic, adLockOptimistic
If Not xRs.EOF Then
Nombre = "" & xRs.Fields("Nombre").value
Ciudad = "" & xRs.Fields("Loc").value
GetBanco = True
Else
GetBanco = False
End If
xRs.Close
Set xRs = Nothing
End Function
Public Function FreeADOCnn() As Boolean
If Not cnn Is Nothing Then
If cnn.State = adStateOpen Then
cnn.Close
Set cnn = Nothing
End If
End If
End Function
Public Function GetADOCnn(mp As SJEParametros) As ADODB.Connection
If cnn Is Nothing Then
Set cnn = New ADODB.Connection
cnn.CommandTimeout = 90
cnn.ConnectionTimeout = 90
End If
If Not cnn.State = adStateOpen Then
cnn.Open "Provider=vfpoledb.1;Data Source=" & mp.PathOrigen &
";Collating Sequence=general"
End If
Set GetADOCnn = cnn
End Function
Public Function GetBeneficiario(mp As SJEParametros, NroBeneficiario As
String, Nombre As String, nroCuenta As String) As Boolean
Dim xRs As New ADODB.Recordset
xRs.Open "select * from SJEA110 where NROJUB=" & NroBeneficiario & "",
GetADOCnn(mp), adOpenStatic, adLockOptimistic
If Not xRs.EOF Then
Nombre = "" & xRs.Fields("NOMBRE").value
nroCuenta = "" & xRs.Fields("NROCUE").value
GetBeneficiario = True
Else
GetBeneficiario = False
End If
xRs.Close
Set xRs = Nothing
End Function
Public Function GetBeneficiarioOBJ(mp As SJEParametros, NroBeneficiario As
String) As Beneficiario
Dim xRs As New ADODB.Recordset
Dim b As Beneficiario
xRs.Open "select * from SJEA110 where NROJUB=" & NroBeneficiario & "",
GetADOCnn(mp), adOpenStatic, adLockOptimistic
If Not xRs.EOF Then
Set b = New Beneficiario
b.Nombre = "" & xRs.Fields("NOMBRE").value
b.Numero = NroBeneficiario
Set GetBeneficiarioOBJ = b
Else
GetBeneficiarioOBJ = Nothing
End If
xRs.Close
Set b = Nothing
Set xRs = Nothing
End Function
Public Function GetMonedaSWIFT(mp As SJEParametros, sjeMoneda As Long,
monedaSWIfT As String) As Boolean
Dim xRs As New ADODB.Recordset
xRs.Open "select SWIFT from SJEA002 where MON=" & sjeMoneda & "",
GetADOCnn(mp), adOpenForwardOnly, adLockOptimistic
If Not xRs.EOF Then
monedaSWIfT = "" & xRs.Fields("SWIFT").value
GetMonedaSWIFT = True
Else
GetMonedaSWIFT = False
End If
xRs.Close
Set xRs = Nothing
End Function
Public Function GetMonedaObj(mp As SJEParametros, sjeMoneda As Long) As
Moneda
Dim xRs As New ADODB.Recordset
Dim m As Moneda
xRs.Open "select Nombre,Simb,SWIFT from SJEA002 where MON=" & sjeMoneda
& "", GetADOCnn(mp), adOpenForwardOnly, adLockOptimistic
If Not xRs.EOF Then
Set m = New Moneda
m.Denominacion = "" & xRs.Fields("Nombre").value
m.Simbolo = "" & xRs.Fields("Simb").value
m.SWIFTCod = "" & xRs.Fields("SWIFT").value
m.SJECod = sjeMoneda
Set GetMonedaObj = m
Else
Set GetMonedaObj = Nothing
End If
xRs.Close
Set m = Nothing
Set xRs = Nothing
End Function
Public Function GetMonedaDescripcion(mp As SJEParametros, sjeMoneda As Long,
descripcion As String, Optional Simbolo As String) As Boolean
Dim xRs As New ADODB.Recordset
xRs.Open "select Nombre,Simb from SJEA002 where MON=" & sjeMoneda & "",
GetADOCnn(mp), adOpenForwardOnly, adLockOptimistic
If Not xRs.EOF Then
descripcion = "" & xRs.Fields("Nombre").value
Simbolo = "" & xRs.Fields("Simb").value
GetMonedaDescripcion = True
Else
GetMonedaDescripcion = False
End If
xRs.Close
Set xRs = Nothing
End Function
Function ImprimeReporteResumen(items As Dictionary, subHeaders As String) As
Boolean
On Error GoTo myError
Set frmPrintResumen.PrintItems = items
frmPrintResumen.subHeaders = subHeaders
frmPrintResumen.Show 1
Exit Function
myError:
If Err Then Err.Raise Err.Number, Err.Source, Err.Description
End Function
El día 20/04/07, Hernan Alderete <[EMAIL PROTECTED]> escribió:
Hola Daniel, el oledb es el que estoy usando y mdac28sp1 no lo instale,
puesto
que tengo un xp. y hace horas que estoy dando vueltas y nada, pero me deja
mas
tranquilo saber que a vos si te funciona. así que deberé ver que si es la
pc
Muchas gracias
Hernán
-------------------------------------------------
Este E-Mail fue enviado a traves de Coopenet Web-Mail
www.coopenet.com.ar
--
Daniel A. Calvin
Cooperator Team Member
http://www.cooperator.com.ar
Microsoft Certified Professional
