如何在 access 和 windows 7 中再次询问二维码问题

问题描述

我的最后一个问题被删除了。然而人们回应了，谢谢你，我听从了他们的建议。由于假期和Covid，我花时间去做这件事。我还有一个问题要概述。

使用 QRCodeLib.xlam 库，我创建了一个无可挑剔的二维码……不幸的是，我无法从 Access 调用它。请参阅下面的访问代码：

    Public Sub GenQRCode()


Dim gxlApp      As Excel.Application
Dim gxlWB       As Workbook
Dim PAYLOAD_1   As String   ' chaîne de caractères à coder
Dim strFile     As String

strFile = "D:\QRCodeLibVBA-master\QRCodeLibDemo.xlsm"
PAYLOAD_1 = "SPC" & vbCrLf & _
        "0200" & vbCrLf & _
        "1" & vbCrLf & _
        "CH4431999123000889012" & vbCrLf & _
        "S" & vbCrLf & _
        "Robert Schneider AG" & vbCrLf & _
        "Via Casa Postale" & vbCrLf & "1268" & vbCrLf & _
        "2501" & vbCrLf & "Biel" & vbCrLf & _
        "CH" & vbCrLf & _
        vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
        "123949.75" & vbCrLf & _
        "CHF" & vbCrLf & _
        "S" & vbCrLf & _
        "Pia-Maria Rutschmann-Schnyder" & vbCrLf & _
        "Grosse Marktgasse" & vbCrLf & "28/5" & vbCrLf & _
        "9400" & vbCrLf & "Rorschach" & vbCrLf & _
        "CH" & vbCrLf & _
        "QRR" & vbCrLf & "210000000003139471430009017" & vbCrLf & _
        "Beachten sie unsere Sonderangebotswoche bis 23.02.2017!" & vbCrLf & _
        "EPD" & vbCrLf & "//S1/10/10201409/11/181105/40/0:30" & vbCrLf & _
        "eBill/B/41010560425610173"
        
Set gxlApp = CreateObject("Excel.Application")
gxlApp.Visible = True
Set gxlWB = gxlApp.Workbooks.Open(strFile,False,False)
With gxlWB
    .gettxt (PAYLOAD_1)
    .qrCode
End With
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

通过站点 https://api.qrserver.com/v1/create-qr-code/，我设法在 Access 中创建了一个二维码……但是所有的换行符都从结果中删除了。请参阅下面的访问表单代码。我创建了一个表单来创建二维码和一个报告来公开它。

    Private Sub btnCode2_Click()
         Call GetQRCode(Me.txtToCode,150,150)
    End Sub

    Sub GetQRCode(Content As String,Width As Integer,Height As Integer)
        Dim ByteData() As Byte
        Dim XmlHttp As Object
        Dim HttpReq As String
        Dim ReturnContent As String
        Dim EncContent As String
        Dim QRImage As String
        EncContent = EncodeURL(Content)

        HttpReq = "https://api.qrserver.com/v1/create-qr-code/?data=" & EncContent & "&size=" & Width & "x" & Height & ""

        Set XmlHttp = CreateObject("MSXML2.XmlHttp")
        XmlHttp.Open "GET",HttpReq,False
        XmlHttp.Send
        ByteData = XmlHttp.responseBody
        Set XmlHttp = nothing

        ReturnContent = StrConv(ByteData,vbUnicode)
        Call Exportimage(ReturnContent)
    End Sub

    Sub Exportimage(image As String)

        On Error GoTo NoSave    
        m_FilePath = Application.CurrentProject.Path & "\qr.png"
        Open m_FilePath For Binary As #1
        Put #1,1,image
        Close #1
       ' Build Export Path
       DoCmd.OpenReport "Table1",acViewPreview

    Exit Sub
   NoSave:
     MsgBox "Could not save the QR Code Image! Reason: " & Err.Description,vbCritical,"File Save Error"
    End Sub

    Private Function EncodeURL(str As String)
        Dim ScriptEngine As Object
        Dim encoded As String
        Dim Temp As String

        Temp = Replace(str," ","%20")
        Temp = Replace(Temp,"#","%23")
        EncodeURL = Temp
    End Function

    Private Sub Form_Load()
        Me.txtToCode.Value = "SPC" & vbCrLf & _
            "0200" & vbCrLf & _
            "1" & vbCrLf & _
            "CH4431999123000889012" & vbCrLf & _
            "S" & vbCrLf & _
            "Robert Schneider AG" & vbCrLf & _
            "Via Casa Postale" & vbCrLf & "1268" & vbCrLf & _
            "2501" & vbCrLf & "Biel" & vbCrLf & _
            "CH" & vbCrLf & _
            vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
            "123949.75" & vbCrLf & _
            "CHF" & vbCrLf & _
            "S" & vbCrLf & _
            "Pia-Maria Rutschmann-Schnyder" & vbCrLf & _
            "Grosse Marktgasse" & vbCrLf & "28/5" & vbCrLf & _
            "9400" & vbCrLf & "Rorschach" & vbCrLf & _
            "CH" & vbCrLf & _
            "QRR" & vbCrLf & "210000000003139471430009017" & vbCrLf & _
            "Beachten sie unsere Sonderangebotswoche bis 23.02.2017!" & vbCrLf & _
            "EPD" & vbCrLf & "//S1/10/10201409/11/181105/40/0:30" & vbCrLf & _
            "eBill/B/41010560425610173"
    End Sub

有人可以帮我吗？

解决方法

我猜您还需要转换换行符，例如：

Temp = Replace(Temp,vbCrLf,"%0d%0a")