VB not working in access 16 format (1 Viewer)

[iaasiqbal]

Option Compare Database Option Explicit Public gxlApp As Excel.Application Public gxlWB As Excel.Workbook Private Sub btnGenerate_Click() End Sub Private Sub Form_Load() Dim rsParent As DAO.Recordset2 Dim rsChild As DAO.Recordset2 Dim fld As DAO.Field2 Dim strExcel As String strExcel = CurrentProject.Path & "\QRCode.xlsm" If Dir(strExcel) = "" Then Set rsParent = CurrentDb.OpenRecordset("tblQRSheet", dbOpenDynaset) rsParent.MoveFirst Set rsChild = rsParent.Fields("attachment").Value Set fld = rsChild.Fields("FileData") fld.SaveToFile strExcel Set fld = Nothing rsChild.Close rsParent.Close Set rsChild = Nothing Set rsParent = Nothing End If If Dir(CurrentProject.Path & "\QRCodeImages", vbDirectory) = "" Then MkDir CurrentProject.Path & "\QRCodeImages" End If Set gxlApp = CreateObject("Excel.Application") Set gxlWB = gxlApp.Workbooks.Open(CurrentProject.Path & "\QRCode.xlsm", False, False) End Sub Private Sub btbGenerate_Click() If Not IsNull(Me!QRText) Then MakeQRCode Me!QRText, Me!ID Me.Refresh End If End Sub Private Sub btnMulti_Click() Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("SELECT * FROM QueryLockerInv") If rs.EOF Then MsgBox "No records to create images for." Else DoCmd.Hourglass True While Not rs.EOF MakeQRCode rs!QRText, rs!ID rs.MoveNext Wend DoCmd.Hourglass False Me.Refresh End If End Sub Private Sub btnReport_Click() DoCmd.OpenReport "Locker_Inventory", acViewPreview End Sub Sub MakeQRCode(strSample As String, intID As Integer) Dim chtO As ChartObject Dim x As Integer With gxlWB .Sheets(1).textbox1.Value = strSample & "" .Sheets(1).textbox1_change .Sheets(1).CommandButton1_Click While gxlApp.CalculationState <> 0 'xlDone DoEvents Wend .Sheets(2).CommandButton1_Click While gxlApp.CalculationState <> 0 DoEvents Wend x = Choose(.Sheets(1).Range("B3"), 21, 25, 29, 33, 37, 41, 45, 49, 53, 57, 61, 65, 69, 73, 77, 61, 85, 89, 93, 97, 101, 105, 109, 113, 117, 121, 125, 129, 133, 137, 141, 145, 149, 153, 157, 161, 165, 169, 173, 177) .Sheets(2).Range(.Sheets(2).Cells(2, 2), .Sheets(2).Cells(1 + x, 1 + x)).CopyPicture appearance:=xlScreen, Format:=xlBitmap Set chtO = .Sheets(2).ChartObjects.Add(1, 1, 200, 200) End With With chtO .Chart.Paste .Chart.Export FileName:=CurrentProject.Path & "\QRCodeImages\QRCode" & intID & ".bmp", FilterName:="BMP" .Delete End With End Sub Private Sub Form_Unload(Cancel As Integer) If Not (gxlWB Is Nothing) Then gxlWB.Close False End If If Not (gxlApp Is Nothing) Then gxlApp.Quit End If Set gxlWB = Nothing Set gxlApp = Nothing End Sub

 

[arnelgp]

you already posted same question here:

Access 16 format not working

This file not working in access 16 format

www.access-programmers.co.uk

 

[Uncle Gizmo]

I have locked the thread because you have another thread which is very similar.

Copy the code from this thread into the other thread if you need people to see it and please use the code tags.