Dopo una giornata di tentativi, ho finalmente trovato una soluzione funzionante, che posto qui di seguito. E' sicuramente migliorabile, ma la mia conoscenza di VBA, per ora, arriva fino a qui...
Public Function CalcoloDataPagamento(intTipoPagamento As Integer, pdatafattura As Date, pidfattura As Integer, pimporto As Currency, nometabella As String, nomecampo As String)
'Parametri da passare in ordine:ID tipo pagamento, Data fattura, ID fattura, Importo fattura, nome tabella pagamenti tra doppi apici, nome campo id fattura tra doppi apici
On Error GoTo Err_handler
Dim dt As Date
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim aint As Integer
Dim bint As Integer
Dim i As Integer
Dim dint As Integer
Set rst = DBEngine(0)(0).OpenRecordset("SELECT * FROM TblCPcalcolopagamento WHERE NUMtabCPIDtabTPid= " & intTipoPagamento & " ORDER BY IDtabCPid ASC", dbOpenSnapshot, dbReadOnly)
'apro un recordset con i dati per il calcolo del pagamento fattura
rst.MoveLast
bint = rst.RecordCount 'valorizzo la variabile con il numero di scadenze per il metodo di pagamento corrente
Set rst1 = DBEngine(0)(0).OpenRecordset(nometabella, dbOpenDynaset)
'apro un recordset nuovo nella tabella delle scadenze
Set rst2 = DBEngine(0)(0).OpenRecordset("SELECT * FROM " & nometabella & " WHERE " & nomecampo & "= " & pidfattura, dbOpenDynaset)
'apro un recordset filtrato per verificare se sono presenti records nella tabella scadenze con id fattura corrente
If Not rst2.EOF Then 'se il recordset non e' vuoto
rst2.MoveLast 'scorro il recordset
aint = rst2.RecordCount 'associo il numero di records alla variabile
Else
aint = 0 'valorizzo la variabile se recordset vuoto
End If
Select Case True
Case aint = 0 'caso con nessun record in tabella scadenze
rst.MoveFirst
For i = 1 To bint
dt = DateAdd("d", rst.Fields(3), pdatafattura) 'Aggiungo i giorni(3)
dt = DateAdd("m", rst.Fields(2), dt) 'Aggiungo i mesi(2)
If rst.Fields(4) Then
dt = DateSerial(Year(dt), Month(dt) + 1, 0) 'Calcolo il fine mese(4)
End If
dt = DateAdd("d", rst.Fields(5), dt) 'Aggiungo gli ulteriori giorni(5)
rst1.AddNew 'aggiungo nuovo record al recordset
rst1.Fields(1) = pidfattura 'compilo il campo con ID fattura
rst1.Fields(2) = dt 'compilo il campo con la data scadenza fattura
rst1.Fields(3) = pimporto * rst.Fields(6) 'calcolo e compilo il campo dell'importo in scadenza
If i = bint Then 'se e' l'ultima scadenza
rst1.Fields(4) = True 'compilo il flag per evasione ultimo pagamento
Else
rst1.Fields(4) = False
End If
rst1.Update
rst.MoveNext
Next i
Case aint > 0 And bint = aint 'caso in cui sono presenti records nella tabella scadenze ed il numero di scadenze e' uguale
rst.MoveFirst 'mi muovo al primo record
rst2.MoveFirst 'mi muovo al primo record
For i = 1 To bint
dt = DateAdd("d", rst.Fields(3), pdatafattura) 'Aggiungo i giorni(3)
dt = DateAdd("m", rst.Fields(2), dt) 'Aggiungo i mesi(2)
If rst.Fields(4) Then
dt = DateSerial(Year(dt), Month(dt) + 1, 0) 'Calcolo il fine mese(4)
End If
dt = DateAdd("d", rst.Fields(5), dt) 'Aggiungo gli ulteriori giorni(5)
rst2.Edit 'modifico record corrente
rst2.Fields(1) = pidfattura 'compilo il campo con ID fattura
rst2.Fields(2) = dt 'compilo il campo con la data scadenza fattura
rst2.Fields(3) = pimporto * rst.Fields(6) 'calcolo e compilo il campo dell'importo in scadenza
If i = bint Then
rst2.Fields(4) = True 'compilo il flag per evasione ultimo pagamento
Else
rst2.Fields(4) = False
End If
rst2.Update
rst2.MoveNext
rst.MoveNext
Next i
Case aint > 0 And bint > aint 'caso in cui sono presenti records nella tabella scadenze ma il numero di scadenze e' maggiore
rst.MoveFirst
rst2.MoveFirst
For i = 1 To bint
If i <= aint Then 'correggo i records esistenti
dt = DateAdd("d", rst.Fields(3), pdatafattura) 'Aggiungo i giorni(3)
dt = DateAdd("m", rst.Fields(2), dt) 'Aggiungo i mesi(2)
If rst.Fields(4) Then
dt = DateSerial(Year(dt), Month(dt) + 1, 0) 'Calcolo il fine mese(4)
End If
dt = DateAdd("d", rst.Fields(5), dt) 'Aggiungo gli ulteriori giorni(5)
rst2.Edit 'modifico record corrente
rst2.Fields(1) = pidfattura 'compilo il campo con ID fattura
rst2.Fields(2) = dt 'compilo il campo con la data scadenza fattura
rst2.Fields(3) = pimporto * rst.Fields(6) 'calcolo e compilo il campo dell'importo in scadenza
rst2.Fields(4) = False 'rimuovo il flag di ultimo pagamento qualora fosse attivo
rst2.Update
If Not rst2.EOF Then
rst2.MoveNext
End If
Else 'aggiungo gli ulteriori records non presenti
dt = DateAdd("d", rst.Fields(3), pdatafattura) 'Aggiungo i giorni(3)
dt = DateAdd("m", rst.Fields(2), dt) 'Aggiungo i mesi(2)
If rst.Fields(4) Then
dt = DateSerial(Year(dt), Month(dt) + 1, 0) 'Calcolo il fine mese(4)
End If
dt = DateAdd("d", rst.Fields(5), dt) 'Aggiungo gli ulteriori giorni(5)
rst1.AddNew 'aggiungo un nuovo record
rst1.Fields(1) = pidfattura 'compilo il campo con ID fattura
rst1.Fields(2) = dt 'compilo il campo con la data scadenza fattura
rst1.Fields(3) = pimporto * rst.Fields(6) 'calcolo e compilo il campo dell'importo in scadenza
If i = bint Then
rst1.Fields(4) = True 'compilo il flag per evasione ultimo pagamento
Else
rst1.Fields(4) = False
End If
rst1.Update
End If
rst.MoveNext
Next i
Case aint > 0 And bint < aint 'caso in cui sono presenti records nella tabella scadenze ma il numero di scadenze e' minore
rst.MoveFirst
rst2.MoveFirst
For i = 1 To aint
If i <= bint Then 'correggo i records esistenti
dt = DateAdd("d", rst.Fields(3), pdatafattura) 'Aggiungo i giorni(3)
dt = DateAdd("m", rst.Fields(2), dt) 'Aggiungo i mesi(2)
If rst.Fields(4) Then
dt = DateSerial(Year(dt), Month(dt) + 1, 0) 'Calcolo il fine mese(4)
End If
dt = DateAdd("d", rst.Fields(5), dt) 'Aggiungo gli ulteriori giorni(5)
rst2.Edit 'correggo il record corrente
rst2.Fields(1) = pidfattura 'compilo il campo con ID fattura
rst2.Fields(2) = dt 'compilo il campo con la data scadenza fattura
rst2.Fields(3) = pimporto * rst.Fields(6) 'calcolo e compilo il campo dell'importo in scadenza
If i = bint Then
rst2.Fields(4) = True 'compilo il flag per evasione ultimo pagamento
Else
rst2.Fields(4) = False
End If
rst2.Update
rst2.MoveNext
Else
rst2.Delete 'cancello i records non piu' necessari dalla tabella delle scadenze
rst2.MoveNext
End If
If Not rst.EOF Then
rst.MoveNext
End If
Next i
End Select
Exit_Err_handler:
rst.Close
rst1.Close
rst2.Close
Set rst = Nothing
Set rst1 = Nothing
Set rst2 = Nothing
Exit Function
Err_handler:
MsgBox Err.Number & " " & Err.Description
Resume Exit_Err_handler
End Function