修改Access VBA导出模块的数值分隔符（逗号改点）

问题背景 #

系统区域以逗号“,”作为小数分隔符，Access数据库查询结果的数值也显示为逗号分隔，导出为特定格式TXT用于其他程序导入时，需要将所有列（除anm列）的逗号小数分隔符替换为点“.”。

原问题代码 #

Option Compare Database
Option Explicit

Public Function fnTransposeToTxt()

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim fd As DAO.Field
    Dim fnum As Integer
    Dim path As String
    Dim OK As Boolean
    Dim var As Variant
    ' export to this file
    path = CurrentProject.path & "\Export.txt"
    
    fnum = FreeFile
    
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("VBK_Knude", dbOpenSnapshot, dbReadOnly)
    
    With rst
        If Not (.BOF And .EOF) Then
            .MoveFirst
            
            OK = True
            
            Open path For Output As fnum
            
        End If
        Do Until .EOF
            For Each fd In .Fields
                var = fd.Value
                Select Case fd.Name
                    Case "Z_F", "DEPTH", "OB", "PERPEND", "Q"
                        var = Format$(Val(var & ""), "0.00")
                    Case "DIMENSION"
                        var = Format$(Val(var & ""), "0.000")
                    Case "CATCHMENT"
                        var = Format$(Val(var & ""), "0.0000")
                End Select
                Print #fnum, fd.Name & " " & var
            Next
            .MoveNext
            If Not (.EOF) Then
                Print #fnum, ""
            End If
        Loop
        .Close
    End With
    
    Set rst = Nothing
    Set dbs = Nothing
    If OK Then
        Close #fnum
    
        MsgBox "table imported to " & path
    End If
                    

End Function

解决方案代码 #

Option Compare Database
Option Explicit

Public Function fnTransposeToTxt()

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim fd As DAO.Field
    Dim fnum As Integer
    Dim path As String
    Dim OK As Boolean
    Dim var As Variant
    ' export to this file
    path = FilToSave
    
    fnum = FreeFile
    
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("VBK_Knude", dbOpenSnapshot, dbReadOnly)
    
    With rst
        If Not (.BOF And .EOF) Then
            .MoveFirst
            
            OK = True
            
            Open path For Output As fnum
            
        End If
        Do Until .EOF
            For Each fd In .Fields
                var = fd.Value
                Select Case fd.Name
                    Case "AFLKOEF"
                        var = Format$(var, "0.0")
                        var = Replace(var, ",", ".")
                    Case "XY", "TEXTXY", "Z_F", "DYBDE", "OB", "PERPEND", "Q", "STATION", "PERPEND", "AFSTRØM"
                        var = Format$(var, "0.00")
                        var = Replace(var, ",", ".")
                    Case "DIMENSION"
                        var = Format$(var, "0.000")
                        var = Replace(var, ",", ".")
                    Case "OPLAND"
                        var = Format$(var, "0.0000")
                        var = Replace(var, ",", ".")
                End Select
                Print #fnum, fd.Name & " " & var
            Next
            .MoveNext
            If Not (.EOF) Then
                Print #fnum, ""
            End If
        Loop
        .Close
    End With
    
    Set rst = Nothing
    Set dbs = Nothing
    If OK Then
        Close #fnum
    
        MsgBox "table imported to " & path
    End If
                    

End Function

关键修改说明 #

• 将固定导出路径CurrentProject.path & "\Export.txt"替换为FilToSave，支持自定义保存路径选择
• 针对每个需要格式化的数值列，在Format$后添加Replace(var, ",", ".")语句，强制将逗号小数分隔符替换为点
• 调整了字段名匹配规则，适配实际数据库中的字段名称（如原DEPTH改为DYBDE、CATCHMENT改为OPLAND）
• 扩展了需要处理的数值列范围，确保所有目标列的小数分隔符都被转换，同时自动排除未在Select Case中定义的anm列

内容的提问来源于stack exchange，提问作者FoolzRailer