多用户项目文本存储截断问题排查求助

核心原因：控制字符触发文件写入终止 #

你遇到的文件截断问题，根源是从网页粘贴的内容包含ASCII控制字符（尤其是Chr(26)，即文件结束符EOF），而VBA的Print #语句会将这类控制字符视为文件结束标记，写入到该字符时就会停止后续内容的输出，直接导致文件被截断。

另外，网页粘贴的内容还可能包含其他不可见控制字符（如Chr(0)空字符、Chr(12)换页符等），这些字符也可能干扰Print #的正常写入逻辑。

具体解决方案 #

1. 过滤特殊控制字符（优先推荐） #

在将单元格内容存入项目数据前，过滤掉所有非必要的控制字符，只保留可打印字符和常用格式字符：

' 定义清理特殊字符的函数
Function CleanInputText(inputStr As String) As String
    Dim i As Integer
    Dim outputStr As String
    Dim charCode As Integer
    
    For i = 1 To Len(inputStr)
        charCode = Asc(Mid(inputStr, i, 1))
        ' 保留可打印ASCII字符（32-126）、换行(10)、回车(13)、制表符(9)
        If (charCode >= 32 And charCode <= 126) Or charCode = 9 Or charCode = 10 Or charCode = 13 Then
            outputStr = outputStr & Mid(inputStr, i, 1)
        Else
            ' 将其他控制字符替换为空格（或直接丢弃）
            outputStr = outputStr & " "
        End If
    Next i
    CleanInputText = outputStr
End Function

修改PrintData中的赋值逻辑：

' 替换原赋值语句，先清理特殊字符
ProjectData(DataToChange) = CleanInputText(ws.Cells(CurrentRow, CurrentColumn).Value)

2. 改用二进制写入替代Print # #

Print #是文本模式写入，会识别控制字符；改用二进制模式的Put语句可以直接写入原始字符串，不会将控制字符视为EOF：

' 替换原文件写入代码段
On Error GoTo NoPath
Open PathToTextFile For Binary As #1
    Put #1, , TextFile
Close #1
On Error GoTo 0
NoPath:
    ' 确保文件被关闭
    If Not IsEmpty(FreeFile()) Then Close #1

同时，读取文件时也要对应改用二进制模式，避免编码问题：

' 替换原文件读取逻辑
Dim TextFile As String
Open PathToTextFile For Binary As #1
    TextFile = Space(LOF(1))
    Get #1, , TextFile
Close #1
Projects = Split(TextFile, Chr(18))

3. 优化多用户并发写入逻辑 #

当前For Output模式会直接覆盖整个文件，多用户同时操作时极易导致数据丢失。可以改用临时文件原子替换的方式，降低并发冲突风险：

' 修改写入部分为临时文件替换
Dim tempPath As String
tempPath = PathToTextFile & ".tmp"

On Error GoTo NoPath
' 先写入临时文件
Open tempPath For Binary As #1
    Put #1, , TextFile
Close #1
' 原子替换原文件（系统级操作，减少冲突）
Kill PathToTextFile
Name tempPath As PathToTextFile
On Error GoTo 0
NoPath:
    ' 清理临时文件
    If Dir(tempPath) <> "" Then Kill tempPath
    Close #1

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