What if I want to assign each value (the array??) to it's own new field? Say y(1) - which would be ProdQty to it's own field? Maybe that's not the way to go. I have an unknown number of entries per string and I was thinking it might be nice to know which position the text value was:
50 (05/01/05), 100 (05/02/05), 150 (05/03/05), 175 (05/04/05)
Would be nice to have:
Position1 Position1a Position2 Position2a
ProdQty1 ProdDate1 ProdQty2 ProdDate2 etc.
50 05/01/05 100 05/02/05
Or any other ideas?
Public Function fblnMakeTable_F_ProdSched()
MakeTbl_F_Data_ProductionSchedule
Dim a, i, x, y, z, strProdSched As String
Set db = CurrentDb
strSQL = "Select * from R_DeliveryStatus"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
rs.MoveFirst
Do While Not rs.EOF
strProdSched = rs.[prodnschedule].Value
x = rs.[FirstOfProjectPOID].Value
If Not IsNull(strProdSched) Then
If Not (strProdSched Like "No New*") Then
If Not (strProdSched Like "Schedule*") Then
a = Split(Replace(strProdSched, " ", ""), ",")
'Debug.Print a
For Each i In a
y = Val(Left(i, InStr(i, "(") - 1))
Debug.Print x
z = CDate(Mid(Left(i, Len(i) - 1), 1 + InStr(i, "(")))
'z = CDate(Mid(i, 1 + InStr(i, "("), 6))
Debug.Print x
If "ProductionPOId" = "11854" Then
MsgBox "ProductionPOId=" & x & ", ProdQty=" & y & ", ProdDate=" & z
End If
CurrentDb.Execute "Insert Into tblProdSched (FirstOfProjectPOID, ProdQty, ProdDate) VALUES (" & x & ", '" & y & "', '" & z & "');"
Next
End If
End If
End If
rs.MoveNext
Loop
rs.Close
End Function
Private Function MakeTbl_F_Data_ProductionSchedule()
On Error GoTo ErrorHandler
DoCmd.RunSQL "CREATE TABLE tblProdSched (FirstOfProjectPOID text(20), ProdQty LONG, ProdDate DateTime)"
CurrentDb.TableDefs.Refresh
ErrorHandler:
Select Case Err.Number
Case 3010
DoCmd.DeleteObject acTable, "tblProdSched"
Resume
'Case Else
'MsgBox Err.Number & " " & Err.Description
End Select
End Function
50 (05/01/05), 100 (05/02/05), 150 (05/03/05), 175 (05/04/05)
Would be nice to have:
Position1 Position1a Position2 Position2a
ProdQty1 ProdDate1 ProdQty2 ProdDate2 etc.
50 05/01/05 100 05/02/05
Or any other ideas?
Public Function fblnMakeTable_F_ProdSched()
MakeTbl_F_Data_ProductionSchedule
Dim a, i, x, y, z, strProdSched As String
Set db = CurrentDb
strSQL = "Select * from R_DeliveryStatus"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
rs.MoveFirst
Do While Not rs.EOF
strProdSched = rs.[prodnschedule].Value
x = rs.[FirstOfProjectPOID].Value
If Not IsNull(strProdSched) Then
If Not (strProdSched Like "No New*") Then
If Not (strProdSched Like "Schedule*") Then
a = Split(Replace(strProdSched, " ", ""), ",")
'Debug.Print a
For Each i In a
y = Val(Left(i, InStr(i, "(") - 1))
Debug.Print x
z = CDate(Mid(Left(i, Len(i) - 1), 1 + InStr(i, "(")))
'z = CDate(Mid(i, 1 + InStr(i, "("), 6))
Debug.Print x
If "ProductionPOId" = "11854" Then
MsgBox "ProductionPOId=" & x & ", ProdQty=" & y & ", ProdDate=" & z
End If
CurrentDb.Execute "Insert Into tblProdSched (FirstOfProjectPOID, ProdQty, ProdDate) VALUES (" & x & ", '" & y & "', '" & z & "');"
Next
End If
End If
End If
rs.MoveNext
Loop
rs.Close
End Function
Private Function MakeTbl_F_Data_ProductionSchedule()
On Error GoTo ErrorHandler
DoCmd.RunSQL "CREATE TABLE tblProdSched (FirstOfProjectPOID text(20), ProdQty LONG, ProdDate DateTime)"
CurrentDb.TableDefs.Refresh
ErrorHandler:
Select Case Err.Number
Case 3010
DoCmd.DeleteObject acTable, "tblProdSched"
Resume
'Case Else
'MsgBox Err.Number & " " & Err.Description
End Select
End Function