vba多文件处理，丢失字节

把具体代码和情况发出来看看

Sub test()
Set fso = CreateObject("Scripting.FileSystemObject") '设置fos系统
Set sht_tis = ThisWorkbook.Sheets("sheet1")
Set exl = CreateObject("excel.application") '设置打开data—name并设置sht名称
Set wj_mc = exl.Workbooks.Open(ThisWorkbook.Path & "\data-name.xlsx")
Set sht_mc = wj_mc.Sheets("sheet1")
da_min = UserForm2.TextBox1.Text '设置最小日期
da_max = UserForm2.TextBox2.Text '设置最大日期
da = DateAdd("d", -1, da_min) '设置起始日期，需减去1用于循环
da_num = DateDiff("d", da_min, da_max) + 1 '获取循环次数，用于显示进度条
UserForm2.Label2.Visible = True
Do
da = DateAdd("d", 1, da) '增加日期1，起始日期开始
rq = Right(da, Len(da) - InStr(6, da, "/")) '转换日期格式
mon = Mid(da, 6, InStr(6, da, "/") - 6) '提取月份
date_sc = da '设置生产日期
date_qf = DateAdd("d", 6, date_sc) '设置签发日期
da_bg = Left(da, 4) * 10000 + mon * 100 + rq '日期转换成批次
'进行日期是否创建进行确认
mypath = ThisWorkbook.Path & "/上传模板" & "/全报告/" & da_bg
If Dir(mypath, vbDirectory) = "" Then
fso.CreateFolder mypath
Else
fso.getfolder(mypath).Delete
fso.CreateFolder mypath
End If
'打开对应日期文件
Set folder = fso.getfolder(ThisWorkbook.Path & "\" & mon & "月")
For Each file In folder.Files
If fso.getbasename(file) = mon & "." & rq Then
Set wj_rq = exl.Workbooks.Open(file)
End If
Next
'设置打开文件日期的sheet
Set sht_rq = wj_rq.Sheets("综合")
num_hs = sht_rq.Range("C65536").End(xlUp).Row
For i = 3 To num_hs '获取实际产品数量
If sht_rq.Cells(i, 3) <> "" Then
num_zs = num_zs + 1
End If
Next
'下述进行进度条的修改
num_ts = num_ts + 1
UserForm1.Label2.Width = UserForm1.Label1.Width / da_num * num_ts
UserForm1.Repaint
'引用日期文件获取并赋值至data-name文件模板，最后另存为
For i = 3 To num_hs
Set wj_mb = exl.Workbooks.Open(ThisWorkbook.Path & "/上传模板/出厂检验报告导入模板.xlsx") '打开上传excel模板
Set sht_mb = wj_mb.Sheets("商品表") '设置sheet商品表
Set sht_xm = wj_mb.Sheets("检验项目表") '设置sheet项目表
If sht_rq.Cells(i, 3) <> "" Then
'进度条进行修改体现
num_jd = num_jd + 1
UserForm1.bar_pro.Width = UserForm1.bar_back.Width / num_zs * num_jd
UserForm1.Repaint
'获取模板文件最后非空单元行
num_mb = sht_mb.Range("b65536").End(xlUp).Row + 1
With wj_rq.Sheets(CStr(sht_rq.Cells(i, 2)))
If Not sht_mc.UsedRange.Find(sht_rq.Cells(i, 25), , , xlWhole) Is Nothing Then
sht_mb.Cells(num_mb, 1) = sht_mc.Cells(sht_mc.UsedRange.Find(sht_rq.Cells(i, 25), , , xlWhole).Row, 2) '赋值商品条码
Else
MsgBox ("产品名称“" & sht_rq.Cells(i, 25) & "”不存在，请修改后再运行！")
Exit Sub
End If
With sht_mb
.Cells(num_mb, 2) = sht_rq.Cells(i, 25) '赋值商品名称
.Cells(num_mb, 3) = da_bg & "M" '赋值生产批次号
.Cells(num_mb, 11) = date_sc '赋值检验日期
.Cells(num_mb, 12) = date_qf '赋值签发日期
.Cells(num_mb, 4) = wj_rq.Sheets(CStr(sht_rq.Cells(i, 2))).Cells(4, 5) '赋值标准
.Cells(num_mb, 5) = "合格" '赋值检测结果
.Cells(num_mb, 7) = "A" '赋值检验人
.Cells(num_mb, 10) = "B" '签发人
.Cells(num_mb, 13) = "C"
.Cells(3, 14).Copy .Cells(num_mb, 14)
End With
ks = .UsedRange.Find("检测项目").Row + 1 + num_ysc '设置开始
js = .UsedRange.Find("结 论").Row - 1 '此处代码不合适，应食用最后非空单元格行数来确认
For p = ks To js '此处设置循环，增加新增单项检验条目，条目数应依据各不同产品不同的检测项目进行改变
Set fnd = sht_tis.Columns(1).Find(.Cells(p, 1), , , xlWhole) '设置获取rq对应ctecl中项目
If fnd Is Nothing Then
sht_tis.Cells(sht_tis.Range("A65536").End(xlUp).Row + 1, 1) = .Cells(p, 1) '若ctexl中无该检测项，则新建插入
fso.DeleteFolder (ThisWorkbook.Path & "\上传模板" & "\全报告\" & da_bg) '删除对应模板文件夹
MsgBox ("综合表格检测项“" & wj_rq.Sheets(CStr(sht_rq.Cells(i, 2))).Cells(p, 1) & "”无对应浙食链检验库名称，请补充后重新运行此代码！")
Exit Sub
ElseIf Not fnd Is Nothing And fnd <> "" And sht_tis.Cells(fnd.Row, 2) <> "" Then
num_ks = sht_xm.Range("A65536").End(xlUp).Row + 1
With sht_xm
.Cells(num_ks, 1) = sht_mb.Cells(num_mb, 1) '赋值商品条码
.Cells(num_ks, 2) = sht_mb.Cells(num_mb, 2) '赋值商品名称
.Cells(num_ks, 3) = sht_mb.Cells(num_mb, 3) '赋值生产批次号
.Cells(num_ks, 4) = sht_tis.Cells(fnd.Row, 2) '赋值浙食链检验库名称
'赋值所有检测项目，（大佬就是这个变量会缺失！）
text_xm = text_xm & "，" & sht_tis.Cells(fnd.Row, 2)
'赋值单位，（大佬就是这个变量会缺失！）
.Cells(num_ks, 5) = sht_tis.Cells(fnd.Row, 3)
'赋值综合表格内技术要求，（大佬就是这个变量会缺失！）
.Cells(num_ks, 6) = wj_rq.Sheets(CStr(sht_rq.Cells(i, 2))).Cells(p, 2)
End With
If .Cells(p, 1) <> "" And .Cells(p + 1, 1) = "" Then '针对微生物五项检测结果进行优化
For q = 0 To 4
text_jg = text_jg & "," & .Cells(p + q, 4)
Next
sht_xm.Cells(num_ks, 7) = text_jg
Else
If sht_tis.Cells(fnd.Row, 2) = "净含量" Then
sht_xm.Cells(num_ks, 7) = Application.Round(.Cells(p, 3), 1)
Else
sht_xm.Cells(num_ks, 7) = .Cells(p, 3) '赋值检验结果，（大佬就是这个变量会缺失！）
End If
End If
sht_xm.Cells(num_ks, 8) = "合格"
End If
text_jg = ""
Next
sht_mb.Cells(num_mb, 6) = text_xm
End With
wj_mb.SaveAs (ThisWorkbook.Path & "/上传模板" & "/全报告/" & da_bg & "/" & sht_rq.Cells(i, 25) & ".xlsx")
wj_mb.Close
End If
text_xm = ""
Next
wj_rq.Close savechanges:=False
num_jd = 0
num_zs = 0
Loop Until DateDiff("d", da, da_max) = 0
wj_mc.Close savechanges:=False
exl.Quit
Set fso = Nothing
Unload UserForm2
Unload UserForm1
MsgBox ("上传模板文件已经创建完成！")
End Sub