debugging - How to view data before insert in VBA? -
i have vba macro (not excel macro) pulling data 1 system , inserting failing.
is there way write text file data trying insert? want see state of data before trying insert.
what code supposed do: take returns erp , insert accpac/gl system. custom macro written this, not pull in old returns. believe because of period being lock in accpac, want see referencing such data.
the mega macro:
option explicit private dsdate1 accpacdatasrc.accpaccustomfield private dsdate2 accpacdatasrc.accpaccustomfield private blncancel boolean private sub cmdexit_click() unload me end sub private sub cmdreceipts_click() dorecpts 'docsv print #2, "interface ended" & close #2 shell "notepad.exe " & "receiptprocess" & format(date, "mmddyyyy") & ".txt" end sub private sub dorecpts() blncancel = false 'dim vrchead accpacview 'dim vrcdet accpacview 'dim vrccomm accpacview 'dim vrcvend accpacview 'dim vrcaddit accpacview 'dim vrcfunct accpacview 'dim vrcpo accpacview 'dim vrcheado accpacview 'dim vrccost accpacview 'dim vrcdeto accpacview 'dim vrcvendo accpacview 'dim vrcaddito accpacview 'dim vrccostdist accpacview 'dim vrcprorate accpacview 'dim vrthead accpacview 'dim vrtdet accpacview 'dim vrtcomm accpacview 'dim vrtfunct accpacview 'dim vrtheado accpacview 'dim vrtdeto accpacview dim vrthead accpaccomapi.accpacview dim vrtdet accpaccomapi.accpacview dim vrtcomm accpaccomapi.accpacview dim vrtfunct accpaccomapi.accpacview dim vrtheado accpaccomapi.accpacview dim vrtdeto accpaccomapi.accpacview 'new dim vrtlinelots accpaccomapi.accpacview dim vrtlineserials accpaccomapi.accpacview dim vvend accpaccomapi.accpacview dim rsrecpt new adodb.recordset dim strsql string dim strerrlog string dim blnerr boolean dim strclast string dim strccurr string dim strtlast string dim strtcurr string dim blnreturn boolean dim blnheaderr boolean dim lngcount long dim vlast string dim vcurr string dim blnbadvend boolean dim start variant dim blneof boolean blneof = false 'dbcmp.openview "po0700", vrchead 'dbcmp.openview "po0710", vrcdet 'dbcmp.openview "po0695", vrccomm 'dbcmp.openview "po0718", vrcvend 'dbcmp.openview "po0714", vrcaddit 'dbcmp.openview "po0699", vrcfunct 'dbcmp.openview "po0705", vrcpo 'dbcmp.openview "po0703", vrcheado 'dbcmp.openview "po0696", vrccost 'dbcmp.openview "po0717", vrcdeto 'dbcmp.openview "po0721", vrcvendo 'dbcmp.openview "po0719", vrcaddito 'dbcmp.openview "po0697", vrccostdist 'dbcmp.openview "po0704", vrcprorate dbcmp.openview "po0731", vrthead dbcmp.openview "po0735", vrtdet dbcmp.openview "po0729", vrtcomm dbcmp.openview "po0730", vrtfunct dbcmp.openview "po0738", vrtheado dbcmp.openview "po0739", vrtdeto dbcmp.openview "po0799", vrtlinelots dbcmp.openview "po0790", vrtlineserials dbcmp.openview "ap0015", vvend 'vrchead.compose array(vrccomm, vrcdet, vrcvend, _ ' vrcaddit, vrcfunct, vrcpo, vrcheado, vrccost) ' 'vrcdet.compose array(vrchead, vrccomm, vrcfunct, _ ' nothing, nothing, vrcdeto) ' ' 'vrccomm.compose array(vrchead, vrcdet) 'vrcvend.compose array(vrchead, vrcaddit, vrcfunct, vrcvendo) ' 'vrcaddit.compose array(vrcvend, vrcfunct, vrchead, nothing, _ ' nothing, vrccost) ' 'vrcfunct.compose array(vrchead, vrccomm, vrcdet, vrcaddit, _ ' vrcvend, vrcpo, vrccost) ' 'vrcpo.compose array(vrchead, vrcfunct) 'vrcheado.compose array(vrchead) 'vrccost.compose array(vrcaddit, vrcvend, vrchead, vrcfunct, vrccostdist) 'vrcdeto.compose array(vrcdet) 'vrcvendo.compose array(vrcvend) 'vrcaddito.compose array(vrcaddit) 'vrccostdist.compose array(nothing, vrccost, vrcaddit) 'vrcprorate.compose array(vrccost, vrcdet) 'vrthead.compose array(vrtcomm, vrtdet, vrtfunct, vrtheado) 'vrtdet.compose array(vrthead, vrtcomm, vrtfunct, _ ' nothing, nothing, vrtdeto) 'vrtcomm.compose array(vrthead, vrtdet) 'vrtfunct.compose array(vrthead, vrtcomm, vrtdet) 'vrtheado.compose array(vrthead) 'vrtdeto.compose array(vrtdet) vrthead.compose array(vrtcomm, vrtdet, vrtfunct, vrtheado) vrtdet.compose array(vrthead, vrtcomm, vrtfunct, nothing, nothing, vrtdeto, vrtlinelots, vrtlineserials) vrtcomm.compose array(vrthead, vrtdet) vrtfunct.compose array(vrthead, vrtcomm, vrtdet, vrtlinelots, vrtlineserials) vrtheado.compose array(vrthead) vrtdeto.compose array(vrtdet) vrtlinelots.compose array(vrtdet, nothing, nothing) vrtlineserials.compose array(vrtdet, nothing, nothing) on error goto recerr strerrlog = "returnerrors.log" ' filter 0 dollar receipts, field rec_header.rh_rtd_cost<>0 strsql = "select rec_header.*, rec_detail.*, vendors.*, inv.* " & _ "from rec_header " & _ "inner join rec_detail on rec_header.rh_id = rec_detail.rd_id " & _ "inner join vendors on rec_header.rh_vendor = vendors.ve_id " & _ "inner join inv on rec_detail.rd_id3 = inv.inv_id3 " & _ "where rec_detail.rd_pst_cou_dtm >= '" & format(fedatestrt, "yyyy-mm-dd hh:mm:ss") & _ "' , rec_detail.rd_pst_cou_dtm < '" & _ format(dateadd("d", 1, fedateend), "yyyy-mm-dd hh:mm:ss") & _ "' , rec_header.rh_status = 'pst'" rsrecpt.open strsql, conn, adopendynamic, adlockoptimistic, adcmdtext rsrecpt until .eof vcurr = .fields("ve_acct") if vcurr <> vlast blnbadvend = false vvend.init vvend.browse "vendorid =" & .fields("ve_acct"), true if vvend.fetch = false goto novend end if if .fields("rd_total") < 0 ' strccurr = .fields("rh_id") ' ' if strccurr <> strclast ' blnreturn = false ' if strclast <> "" ' if blnbadvend = true goto nextdetail ' vrchead.insert ' if strclast <> "" print #2, "receipt " & strclast & " entered." ' if blnheaderr = false lngcount = lngcount + 1 ' blnheaderr = false ' doevents ' if blncancel = true goto finishup ' end if 'redorchead: ' vrchead.recordgenerate false ' lblinfo.caption = "doing receipt no: " & .fields("rh_id") & "..." ' me.repaint ' ' vrchead.fields("vdcode") = .fields("ve_acct") ' vrchead.fields("rcpnumber") = cstr(.fields("rh_id")) ' vrchead.fields("descriptio") = "receiver import apropos" ' vrchead.fields("reference") = .fields("rh_po_id") ' vrchead.fields("date") = .fields("rh_arrival_date") ' ' vrcheado.fields("optfield").putwithoutverification "po" ' vrcheado.fields("value") = .fields("rh_po_id") ' vrcheado.insert ' end if ' vrcdet.recordgenerate false ' vrcdet.fields("itemno") = "inv" ' vrcdet.fields("itemdesc") = .fields("inv_id3") & " - " & .fields("inv_desc") ' vrcdet.fields("rqreceived") = .fields("rd_total") ' vrcdet.fields("unitcost") = round(.fields("rd_cost"), 2) ' if not isnull(.fields("rh_spec_instr")) ' vrccomm.recordgenerate false ' vrccomm.fields("commenttyp") = 1 ' vrccomm.fields("comment") = .fields("rh_spec_instr") ' vrccomm.insert ' end if ' ' if not isnull(.fields("rh_recv_instr")) ' vrccomm.recordgenerate false ' vrccomm.fields("commenttyp") = 1 ' vrccomm.fields("comment") = .fields("rh_recv_instr") ' vrccomm.insert ' end if ' vrcdet.insert ' strclast = strccurr ' else strtcurr = .fields("rh_id") if strtcurr <> strtlast blnreturn = true if strtlast <> "" vrthead.insert if strtlast <> "" print #2, "return " & strtlast & " entered." if blnheaderr = false lngcount = lngcount + 1 blnheaderr = false if blnbadvend = true goto nextdetail doevents if blncancel = true goto finishup end if redorthead: vrthead.recordgenerate false lblinfo.caption = "doing return no: " & .fields("rh_id") & "..." me.repaint vrthead.fields("vdcode") = .fields("ve_acct") vrthead.fields("retnumber") = cstr(.fields("rh_id")) vrthead.fields("descriptio") = "return import apropos" vrthead.fields("reference") = .fields("rh_po_id") vrthead.fields("date") = .fields("rh_arrival_date") vrtheado.fields("optfield").putwithoutverification "po" vrtheado.fields("valiftext") = .fields("rh_po_id") vrtheado.insert end if vrtdet.recordgenerate false vrtdet.fields("itemno") = "inv" vrtdet.fields("itemdesc") = .fields("inv_id3") & " - " & .fields("inv_desc") vrtdet.fields("rqreturned") = -.fields("rd_total") vrtdet.fields("unitcost") = round(.fields("rd_cost"), 2) if not isnull(.fields("rh_spec_instr")) vrtcomm.recordgenerate false vrtcomm.fields("commenttyp") = 1 vrtcomm.fields("comment") = .fields("rh_spec_instr") vrtcomm.insert end if if not isnull(.fields("rh_recv_instr")) vrtcomm.recordgenerate false vrtcomm.fields("commenttyp") = 1 vrtcomm.fields("comment") = .fields("rh_recv_instr") vrtcomm.insert end if vrtdet.insert strtlast = strtcurr end if nextdetail: if .bof or .eof exit .movenext vlast = vcurr loop ' if blnreturn vrthead.insert else vrchead.insert if strtcurr <> "" , blneof = false blneof = true vrthead.insert end if .close end finishup: 'set rsrecpt = nothing 'set vrthead = nothing 'set vrtdet = nothing 'set vrtcomm = nothing 'set vrtfunct = nothing 'set vrchead = nothing 'set vrcdet = nothing 'set vrcaddit = nothing 'set vrccomm = nothing 'set vrcfunct = nothing msgbox lngcount & " returns have been entered accpac", vbokonly + vbinformation, "finished" if blnerr = true shell "notepad.exe " & strerrlog lblinfo.caption = "" me.repaint exit sub novend: if vcurr <> vlast blnbadvend = true if blnerr = false open strerrlog output #1 blnerr = true print #1, "the following returns not entered reasons indicated." else open strerrlog append #1 end if if rsrecpt.fields("rd_total") > 0 print #1, "the vendor " & rsrecpt.fields("ve_acct") & " not exist " & strclast & " not added." else print #1, "the vendor " & rsrecpt.fields("ve_acct") & " not exist " & strtlast & " not added." end if close #1 end if goto nextdetail recerr: if blnerr = false open strerrlog output #1 blnerr = true print #1, "the following returns not entered reasons indicated." else open strerrlog append #1 end if if accpacsession.errors.count > 0 if instr(1, accpacsession.errors(0), "already exists") > 0 print #1, "the return " & strtlast & _ " not added because exists in accpac" vrthead.cancel strtlast = "" close #1 accpacsession.errors.clear err.clear blnheaderr = true resume next end if if instr(1, accpacsession.errors(0), "compute tax") > 0 print #1, "the return " & rsrecpt.fields("rh_id") & _ " not added because cannot compute tax." vrthead.cancel strtlast = "" close #1 accpacsession.errors.clear err.clear blnheaderr = true resume nextdetail end if else print #1, err.description end if close #1 accpacsession.errors.clear err.clear resume nextdetail end sub private sub fedateend_exit(byval cancel msforms.returnboolean) if fedatestrt > fedateend msgbox "the ending date must greater beginning date" fedateend = fedatestrt end if end sub private sub userform_initialize() set dsdate1 = new accpacdatasrc.accpaccustomfield set dsdate2 = new accpacdatasrc.accpaccustomfield dsdate1.init fld_date, fld_editable + fld_enabled dsdate2.init fld_date, fld_editable + fld_enabled fedatestrt.accpacfield = dsdate1 fedateend.accpacfield = dsdate2 fedatestrt = dateadd("d", -7, date) fedateend = date end sub private sub docsv() dim rsrecpt new adodb.recordset dim vvend accpacview dim strsql string dim strerrlog string dim blnerr boolean dim strclast string dim strccurr string dim strtlast string dim strtcurr string dim blnreturn boolean dim blnheaderr boolean dim lngccount long dim lngtcount long dim lngdetail long dim lngcomment long dim vlast string dim vcurr string dim blnbadvend boolean dim start variant dim lngvenderr long dbcmp.openview "ap0015", vvend strsql = "select rec_header.*, rec_detail.*, vendors.*, inv.* " & _ "from rec_header " & _ "inner join rec_detail on rec_header.rh_id = rec_detail.rd_id " & _ "inner join vendors on rec_header.rh_vendor = vendors.ve_id " & _ "inner join inv on rec_detail.rd_id3 = inv.inv_id3 " & _ "where rec_detail.rd_pst_cou_dtm >= '" & format(fedatestrt, "yyyy-mm-dd hh:mm:ss") & _ "' , rec_detail.rd_pst_cou_dtm < '" & format(dateadd("d", 1, fedateend), "yyyy-mm-dd hh:mm:ss") & _ "' , rec_header.rh_status = 'pst'" rsrecpt.open strsql, conn, adopendynamic, adlockoptimistic, adcmdtext open accpacsession.programspathonserver & "receipt import.csv" output #2 open accpacsession.programspathonserver & "return import.csv" output #3 createheaderinfo ' put header line in csv file. rsrecpt until .eof vcurr = .fields("ve_acct") if vcurr <> vlast ' check see if vendor exists blnbadvend = false vvend.init vvend.browse "vendorid =" & .fields("ve_acct"), true if vvend.fetch = false lngvenderr = 1 goto venderr else ' if vendor inactive or on hold. if vvend.fields("swactv") = 0 lngvenderr = 2 goto venderr end if if vvend.fields("swhold") = 1 lngvenderr = 3 goto venderr end if end if end if if .fields("rd_total") > 0 ' if amount >0 it's receipt. strccurr = .fields("rh_id") if strccurr <> strclast ' if current receipt isn't same last. if blnheaderr = false lngccount = lngccount + 1 blnheaderr = false ' write header record. write #2, 1, lngccount, format(.fields("rh_arrival_date"), "yyyymmdd"), _ cstr(.fields("rh_id")), .fields("ve_acct"), "receiver import apropos", _ .fields("rh_po_id") lngdetail = 0 lngcomment = 0 lblinfo.caption = "doing receipt no: " & .fields("rh_id") & "..." me.repaint ' write optional field write #2, 7, lngccount, "po", .fields("rh_po_id") end if ' end of header writing ' write detail line lngdetail = lngdetail + 100 write #2, 2, lngccount, lngdetail, "inv", "", _ .fields("inv_id3") & " - " & .fields("inv_desc"), _ 1, lngdetail, "ea", .fields("rd_total"), round(.fields("rd_cost"), 2) ' if there special instruction if not isnull(.fields("rh_spec_instr")) lngcomment = lngcomment + 10 write #2, 3, lngccount, lngcomment, lngdetail, 1, .fields("rh_spec_instr") end if ' if there receiver instruction if not isnull(.fields("rh_recv_instr")) lngcomment = lngcomment + 10 write #2, 3, lngccount, lngcomment, lngdetail, 1, .fields("rh_recv_instr") end if strclast = strccurr else strtcurr = .fields("rh_id") if strtcurr <> strtlast ' if current receipt isn't same last. if blnheaderr = false lngtcount = lngtcount + 1 blnheaderr = false ' write header record. write #2, 1, lngtcount, format(.fields("rh_arrival_date"), "yyyymmdd"), _ cstr(.fields("rh_id")), .fields("ve_acct"), "receiver import apropos", _ .fields("rh_po_id") lngdetail = 0 lngcomment = 0 lblinfo.caption = "doing receipt no: " & .fields("rh_id") & "..." me.repaint ' write optional field write #2, 7, lngtcount, "po", .fields("rh_po_id") end if ' end of header writing ' write detail line lngdetail = lngdetail + 100 write #2, 2, lngtcount, lngdetail, "inv", "", _ .fields("inv_id3") & " - " & .fields("inv_desc"), _ 1, lngdetail, "ea", .fields("rd_total"), round(.fields("rd_cost"), 2) ' if there special instruction if not isnull(.fields("rh_spec_instr")) lngcomment = lngcomment + 10 write #2, 3, lngtcount, lngcomment, lngdetail, 1, .fields("rh_spec_instr") end if ' if there receiver instruction if not isnull(.fields("rh_recv_instr")) lngcomment = lngcomment + 10 write #2, 3, lngtcount, lngcomment, lngdetail, 1, .fields("rh_recv_instr") end if strtlast = strtcurr end if nextdetail: if .bof or .eof exit .movenext vlast = vcurr loop end set vvend = nothing close #2 close #3 exit sub venderr: if vcurr <> vlast blnbadvend = true if blnerr = false open strerrlog output #1 blnerr = true print #1, "the following receipts not entered reasons indicated." else open strerrlog append #1 end if select case lngvenderr case 1 if rsrecpt.fields("rd_total") > 0 print #1, "the vendor " & rsrecpt.fields("ve_acct") & _ " not exist " & strclast & " not added." else print #1, "the vendor " & rsrecpt.fields("ve_acct") & _ " not exist " & strtlast & " not added." end if case 2 if rsrecpt.fields("rd_total") > 0 print #1, "the vendor " & rsrecpt.fields("ve_acct") & _ " inactive " & strclast & " not added." else print #1, "the vendor " & rsrecpt.fields("ve_acct") & _ " inactive " & strtlast & " not added." end if case 3 if rsrecpt.fields("rd_total") > 0 print #1, "the vendor " & rsrecpt.fields("ve_acct") & _ " on hold " & strclast & " not added." else print #1, "the vendor " & rsrecpt.fields("ve_acct") & _ " on hold " & strtlast & " not added." end if end select close #1 end if goto nextdetail end sub private sub createheaderinfo() open "c:\clients\zumiez\test.txt" output #2 write #2, "rectype", "rcphseq", "date", "rcpnumber", "vdcode", "descriptio", "reference" write #2, "rectype", "rcphseq", "rcplrev", "itemno", "location", "itemdesc", "hascomment", "rcpcseq", "rcpunit", "rqreceived", "unitcost" write #2, "rectype", "rcphseq", "rcpcrev", "rcpcseq", "commenttyp", "comment" write #2, "rectype", "rcphseq", "vdcode" write #2, "rectype", "rcphseq", "vdcode", "rcpsrev" write #2, "rectype", "rcphseq", "vdcode", "rcpsrev", "lseq" write #2, "rectype", "rcphseq", "optfield", "value" write #2, "rectype", "rcphseq", "rcplrev", "optfield" write #2, "rectype", "rcphseq", "vdcode", "optfield" write #2, "rectype", "rcphseq", "vdcode", "rcpsrev", "optfield" close #2 end sub
if want write out field data of each of sage views before call .insert or .update methods can simple loop go through each of fields in view. like:
sub dumpviewfields(aview accpaccomapi.accpacview, afilenumber long) dim idx integer dim output string 'get headers idx = 0 aview.fields.count - 1 output = output & cstr(aview.fields(idx).name) & chr(9) next idx print afilenumber, output 'get data fields output = "" idx = 0 aview.fields.count - 1 output = output & cstr(aview.fields(idx).value) & chr(9) next idx print afilenumber, output end sub i've on simplified writing of field values file idea.