Attribute VB_Name = "MonlamJsonConverter" Option Compare Database Sub exportMonlamIDCardAsForms() Dim recFilterKey As String Dim recSource As String Dim recNo As Long Dim A As Long Dim b As Long Dim recStart As Long Dim recEnd As Long Dim recFilter As String Dim recStep As Integer Dim recFileName As String Dim recReport As String Dim ImageMagick As Object Dim recOutputDir As String Dim recSno As Long Dim recFileNamePrefix As String Dim recFullFilename As String Dim recIdPhotoFolder As String Dim titelToLetter 'titelToLetter = Split("XVTKMMFMS") 'Set ImageMagick = CreateObject("ImageMagickObject.MagickImage.1") recFilterKey = "SNo" 'recStep = 1000 recReport = "Monlam Form Report" ' specialy created report: photo in right size, margin 0, size as small as possible to speedup trim and conversion recIdPhotoFolder = "\Forms" recOutputDir = CurrentProject.Path & recIdPhotoFolder & "\" recSource = "MonlamIDCard Query" 'Me.Form.RecordSource recNo = DCount(recFilterKey, recSource) recFileNamePrefix = "nam_0000_0131_" recFileName = recFileNamePrefix 'create folder if not found If Dir(recOutputDir, vbDirectory) = "" Then 'dir not found MkDir recOutputDir 'make dir End If If Dir(recOutputDir & "\*.pdf") <> "" Then Kill recOutputDir & "\*.pdf" If Dir(recOutputDir & "\*.json") <> "" Then Kill recOutputDir & "\*.json" SysCmd acSysCmdInitMeter, "Creating PDF......", 0 DoCmd.OutputTo acOutputReport, recReport, acFormatPDF, recOutputDir & recFileName & ".pdf" ''2018-12-22 don't convert pdf 'use imagemagic to convert pdf to image 'msgs = ImageMagick.Convert("-density", "200", recOutputDir & recFileName & ".pdf", "-scene", "1", recOutputDir & recFileName & "%04d.jpg") 'Debug.Print msgs 'run convertPdfToJpg.bat to convert pdf to image 'Shell "cmd /c d: && cd """ & recOutputDir & """ && """ & recOutputDir & "convertPdfToJpg.bat""", vbNormalFocus Dim rs As DAO.Recordset Set rs = CurrentDb().OpenRecordset("select * from [MonlamIDCard Query] order by SNo") Dim Time, SNo, PNo, No, MonId_PNo, SourceNoFormNo, SourceNo, FormNo, MonId, SourceNoFormNo_SNo Dim Forms As Dictionary 'Set Forms = New Dictionary 'Set rs = Form.RecordsetClone If Not (rs.BOF And rs.EOF) Then rs.MoveFirst Time = Timer() Set Forms = New Dictionary 'set Forms as dic 'Forms.RemoveAll SysCmd acSysCmdInitMeter, "MonlamIDCard", rs.RecordCount SysCmd acSysCmdUpdateMeter, 0 Do Until rs.EOF = True 'do until EOF DoEvents SNo = rs!SNo SysCmd acSysCmdUpdateMeter, SNo PNo = ((SNo - 1) \ 10) + 1 No = ((SNo - 1) Mod 10) + 1 MonId = 131 MonId_PNo = Right("0000" & MonId, 4) & "_" & Right("0000" & PNo, 4) SourceNo = "nam_0000" FormNo = MonId_PNo SourceNoFormNo = SourceNo & "_" & FormNo SourceNoFormNo_SNo = SourceNoFormNo & "_" & Right("0000" & SNo, 4) 'If FormNo = "0131_0100" Then ' Beep 'End If If Forms.Exists(MonId_PNo) = False Or IsEmpty(Forms(MonId_PNo)) = True Then Set Forms(MonId_PNo) = New Dictionary 'Form table fields Forms(MonId_PNo)("ID") = "" Forms(MonId_PNo)("SourceNoFormNo") = SourceNoFormNo Forms(MonId_PNo)("SourceNo") = SourceNo Forms(MonId_PNo)("FormNo") = FormNo Forms(MonId_PNo)("MonId") = MonId 'Forms(MonId_PNo)("MonId_PNo") = MonId_PNo Forms(MonId_PNo)("PNo") = PNo Set Forms(MonId_PNo)("data") = New Dictionary Set Forms(MonId_PNo)("data")("Form") = JsonConverter.ParseJson("{""w"":1652,""h"":2338,""name"":""" & SourceNoFormNo & ".jpg""}") Set Forms(MonId_PNo)("data")("Ids") = New Dictionary Forms(MonId_PNo)("data")("Ids")("dummy") = "prevent conversion to array in firebase" End If If No = 1 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""142.437"",""y"":""444.686"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":169,""y"":461,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 2 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""142.437"",""y"":""742.463"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":169,""y"":759,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 3 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""142.437"",""y"":""1039.729"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":169,""y"":1059,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 4 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""142.437"",""y"":""1338.401"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":169,""y"":1353,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 5 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""142.437"",""y"":""1634.517"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":169,""y"":1649,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 6 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""796.883"",""y"":""444.686"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":829,""y"":461,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 7 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""796.883"",""y"":""742.463"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":829,""y"":759,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 8 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""796.883"",""y"":""1039.729"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":829,""y"":1059,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 9 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""796.883"",""y"":""1338.401"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":829,""y"":1353,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") ElseIf No = 10 Then Set Forms(MonId_PNo)("data")("Ids")(No) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(No)("Id") = JsonConverter.ParseJson("{""x"":""796.883"",""y"":""1634.517"",""w"":""654.446"",""h"":""296.244"",""title"":""" & Mid("XVTKLDANSO", 1 + rs!Titel, 1) & """,""name"":""" & SourceNoFormNo & "_" & Right("0000" & No, 4) & ".jpg" & """}") Set Forms(MonId_PNo)("data")("Ids")(No)("Participant") = JsonConverter.ParseJson("{""SNo"":""" & SNo & """,""Name"":""" & rs!Name & """,""Age"":""" & rs!Age & """,""Fname"":""" & rs!Fname & """,""Titel"":" & rs!Titel & ",""RemarkNo"":" & rs!RemarkNo & "}") Set Forms(MonId_PNo)("data")("Ids")(No)("Photo") = JsonConverter.ParseJson("{""w"":186,""h"":243,""x"":829,""y"":1649,""name"":""" & SourceNoFormNo_SNo & ".jpg""}") End If Dim lastPNo As Integer, lastNo As Integer lastPNo = PNo lastNo = No rs.MoveNext On Error Resume Next PNo = ((rs!SNo - 1) \ 10) + 1 'if after last record then this will give error but program will work ok as catched by rs.eof No = ((rs!SNo - 1) Mod 10) + 1 If lastPNo <> PNo Or rs.EOF Then For b = lastNo + 1 To 10 Set Forms(MonId_PNo)("data")("Ids")(b) = New Dictionary Set Forms(MonId_PNo)("data")("Ids")(b)("Id") = JsonConverter.ParseJson("{""x"":""796.883"",""y"":""1634.517"",""w"":""654.446"",""h"":""296.244"",""title"":""X"",""name"":""" & SourceNoFormNo & "_" & Right("0000" & b, 4) & ".jpg" & """}") Next Dim Id, dataX, dataV, dataT, dataK, dataM, dataF, dataS, DataTotal dataX = 0: dataV = 0: dataT = 0: dataK = 0: dataM = 0: dataF = 0: dataS = 0: DataTotal = 0 For Id = 1 To 10 If Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "X" Then dataX = dataX + 1 ElseIf Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "V" Then dataV = dataV + 1 ElseIf Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "T" Then dataT = dataT + 1 ElseIf Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "K" Then dataK = dataK + 1 ElseIf Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "L" Or Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "D" Or Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "N" Then dataM = dataM + 1 ElseIf Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "A" Then dataF = dataF + 1 ElseIf Forms(MonId_PNo)("data")("Ids")(Id)("Id")("title") = "S" Then dataS = dataS + 1 End If Next DataTotal = dataX + dataV + dataT + dataK + dataM + dataF + dataS Forms(MonId_PNo)("dataX") = dataX Forms(MonId_PNo)("dataV") = dataV Forms(MonId_PNo)("dataT") = dataT Forms(MonId_PNo)("dataK") = dataK Forms(MonId_PNo)("dataM") = dataM Forms(MonId_PNo)("dataF") = dataF Forms(MonId_PNo)("dataS") = dataS Forms(MonId_PNo)("dataTotal") = DataTotal Forms(MonId_PNo)("stamp") = Format$(Now(), "yyyy/mm/dd h:mm:ss ampm") Set Forms(MonId_PNo)("timestamp") = JsonConverter.ParseJson("{"".sv"": ""timestamp""}") End If Debug.Print "Page: " & lastPNo & " No: " & lastNo & " Key: " & MonId_PNo ', Left(JsonConverter.ConvertToJson(Forms(MonId_PNo)), 250) 'rs.MoveNext Loop SysCmd acSysCmdInitMeter, "Saving JSON", 4 SysCmd acSysCmdUpdateMeter, 1 'Debug.Print JsonConverter.ConvertToJson(Forms) Dim jsonStr As String 'Dim firebasePath As String jsonStr = JsonConverter.ConvertToJson(Forms) SysCmd acSysCmdUpdateMeter, 2 'firebasePath = "Monlam Form Register" 'writeToFirebase firebaseProject, firebaseAuth, firebasePath, "PATCH", jsonStr 'Debug.Print "writeToFirebase", firebaseProject, firebaseAuth, firebasePath, "PATCH" ', JsonConverter.ConvertToJson(Forms) Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim oFile As Object Set oFile = fso.CreateTextFile(recOutputDir & recFileName & ".json") oFile.WriteLine jsonStr oFile.Close Set fso = Nothing Set oFile = Nothing SysCmd acSysCmdUpdateMeter, 3 Debug.Print Timer() - Time End If Dim cloudDir As String cloudDir = "C:\Users\hp\CloudStation\" FileCopy recOutputDir & recFileName & ".json", cloudDir & recFileName & ".json" FileCopy recOutputDir & recFileName & ".pdf", cloudDir & recFileName & ".pdf" SysCmd acSysCmdUpdateMeter, 4 SysCmd acSysCmdRemoveMeter 'open output directory Shell "C:\WINDOWS\explorer.exe """ & recOutputDir & "", vbNormalFocus Set Forms = Nothing End Sub