- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- 批量导入excel 提示从字符串“来源列数”到类型“Integer”的转换无效。 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=174098)
-- 发布时间：2021/12/31 13:29:00
-- 批量导入excel 提示从字符串“来源列数”到类型“Integer”的转换无效。
批量导入excel 提示从字符串“来源列数”到类型“Integer”的转换无效。麻烦老师们帮忙看看是哪里出问题了呢？
For Each Ctl As winform.Control In e.Form.Controls
Ctl.Font = New Font("微软雅黑",9)
Next
Dim dtb As New DataTableBuilder("统计")
dtb.AddDef("来源字段", Gettype(String), 100)
dtb.AddDef("来源列数", Gettype(Integer), 6)
dtb.AddDef("接收字段", Gettype(String), 100)
With e.Form.Controls("Table1").Table
.datasource = dtb.BuildDataSource
.allowedit = True
.AllowResizeRow = False
.SetColVisibleWidth("来源字段|220|接收字段|220")
.DataTable.SysStyles("EmptyArea").BackColor = Color.Whitesmoke
.DataTable.SysStyles("Alternate").BackColor = Color.LightCyan
End With
批量到如文件代码如下：
Dim cm2 As WinForm.ComboBox = e.Form.Controls("ComboBox2")
Dim prb As WinForm.ProgressBar = e.Form.Controls("ProgressBar1")
Dim r As Row
Dim i,j As Integer
Dim t1,t2 As Table
Dim str1,str2 As String
Dim str As String
If cm2.Text="" Then
MessageBox.Show("请先选择要接收的数据表,然后再进行文件选择.字段匹配.数据导入操作!","温馨提示")
Else
Dim c4 As WinForm.ComboBox = e.Form.Controls("ComboBox4")
If c4.text <>"" Then
Dim b1 As String= "1:" & c4.text
With e.Form
Dim dlg As New OpenFileDialog
dlg.Filter= "Excel 97-2003文件(*.xls)|*.xls|Excel 2007文件(*.xlsx)|*.xlsx"
If dlg.ShowDialog = DialogResult.Ok Then
For Each File As String In FileSys.GetFiles(FileSys.GetParentPath(dlg.FileName))
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(File)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Rows(b1) \'选定多行
Rg.EntireRow.Delete(MSExcel.XlDirection.xlToLeft) \'右面的单元格左移
App.Visible = False
If cm2.text="台账明细表" Then
Dim Rg1 As MSExcel.Range = Ws.Cells(1,8)
Rg1.Value = "谈话开始时间"
Dim Rg2 As MSExcel.Range = Ws.Cells(1,9)
Rg2.Value = "谈话结束时间"
End If
If Wb.WorkSheets(1).name ="sheet1" Then
Wb.WorkSheets(1).name = "台账明细表"
End If
Dim t11 As String =Format(Date.Now,"yyyyMMddhhmmss")
Dim dz As String = FileSys.GetParentPath(File) & "\\" & t11 & FileSys.GetName(File)
Wb.SaveAs(dz)
wb.close
app.quit
.Controls("TextBox1").value = FileSys.GetParentPath(dlg.FileName)
t1 = Tables(cm2.Text)
t2 = e.form.Controls("Table1").Table
str1 = e.form.Controls("TextBox1").value
str2 = e.form.Controls("combobox3").value
If str1 = "" Then
Return
End If
Dim Book As New XLS.Book(dz)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
For j = 0 To Sheet.Cols.count - 1
If t1.cols.Contains(Sheet(0,j).value) Then
If str = "" Then
str = Sheet(0,j).value
str = str.Replace(" ", "").Trim
Else
str = str & "," & Sheet(0,j).value
str = str.Replace(" ", "").Trim
End If
End If
Next
Dim dr As DataRow
For i = 1 To Sheet.Rows.Count -1
Dim sss As String = ""
prb.Visible = True
prb.Maximum = Sheet.Rows.Count - 1
For Each r In Tables(cm2.Text).Rows
For j = 0 To str.split(",").Length - 1
If sss > "" Then sss = sss & " and "
sss = sss & str.split(",")(j) & "=\'" & Sheet(i,t2.Rows(j)("来源列数")).Value & "\'"
Next
Next
dr = DataTables(cm2.Text).find(sss)
If dr Is Nothing Then
r = t1.AddNew()
For j = 0 To str.split(",").Length - 1
r(str.split(",")(j)) = Sheet(i,t2.Rows(j)("来源列数")).Value
Next
t1.DataTable.save
End If
Next
Next
prb.Value = i
MessageBox.Show("数据导入完毕!","温馨提示!")
End If
End With
End If
End If
运行提示：
-- 发布时间：2021/12/31 13:38:00
--
调试技巧：http://www.foxtable.com/webhelp/scr/1485.htm，看哪一句代码出错
-- 发布时间：2021/12/31 13:46:00
-- 回复：（有点蓝）调试技巧：http://www.foxtable.com/...
弹出7之后 报错一楼错误提示图
[此贴子已经被作者于2021/12/31 13:46:22编辑过]
-- 发布时间：2021/12/31 13:51:00
--
For Each r In Tables(cm2.Text).Rows
For j = 0 To str.split(",").Length - 1
If sss > "" Then sss = sss & " and "
msgbox(t2.Rows(j)("来源列数"))
sss = sss & str.split(",")(j) & "=\'" & Sheet(i,t2.Rows(j)("来源列数")).Value & "\'"
Next
Next
-- 发布时间：2021/12/31 14:16:00
-- 回复：（有点蓝） ...
For Each r In Tables(cm2.Text).Rows
For j = 0 To str.split(",").Length - 1
If sss > "" Then sss = sss & " and "
msgbox(t2.Rows(j)("来源列数"))
sss = sss & str.split(",")(j) & "=\'" & Sheet(i,t2.Rows(j)("来源列数")).Value & "\'"
Next
Next
提示：
-- 发布时间：2021/12/31 14:52:00
--
表格没有数据，那么t2.Rows(j)("来源列数")就会取到列名。判断一个表格是否有数据在遍历
-- 发布时间：2021/12/31 15:00:00
-- 回复：（有点蓝）表格没有数据，那么t2.Rows(j)("来源...
按老师提示 当前代码完善如下 还是会报错！
当前是部分表成功导入数据 部分表没有导入
提示错误：
无法在 System.Double 和 System.String 上执行“=”操作。
Dim cm2 As WinForm.ComboBox = e.Form.Controls("ComboBox2")
Dim prb As WinForm.ProgressBar = e.Form.Controls("ProgressBar1")
Dim r As Row
Dim i,j As Integer
Dim t1,t2 As Table
Dim str1,str2 As String
Dim str As String
If cm2.Text="" Then
MessageBox.Show("请先选择要接收的数据表,然后再进行文件选择.字段匹配.数据导入操作!","温馨提示")
Else
Dim c4 As WinForm.ComboBox = e.Form.Controls("ComboBox4")
If c4.text <>"" Then
Dim b1 As String= "1:" & c4.text
With e.Form
Dim dlg As New OpenFileDialog
dlg.Filter= "Excel 97-2003文件(*.xls)|*.xls|Excel 2007文件(*.xlsx)|*.xlsx"
If dlg.ShowDialog = DialogResult.Ok Then
For Each File As String In FileSys.GetFiles(FileSys.GetParentPath(dlg.FileName))
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(File)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Rows(b1) \'选定多行
Rg.EntireRow.Delete(MSExcel.XlDirection.xlToLeft) \'右面的单元格左移
App.Visible = False
If cm2.text="台账明细表" Then
Dim Rg1 As MSExcel.Range = Ws.Cells(1,8)
Rg1.Value = "谈话开始时间"
Dim Rg2 As MSExcel.Range = Ws.Cells(1,9)
Rg2.Value = "谈话结束时间"
End If
If Wb.WorkSheets(1).name ="Sheet" Then
Wb.WorkSheets(1).name = "台账明细表"
End If
Dim t11 As String =Format(Date.Now,"yyyyMMddhhmmss")
Dim dz As String = FileSys.GetParentPath(File) & "\\" & t11 & FileSys.GetName(File)
Wb.SaveAs(dz)
wb.close
app.quit
.Controls("TextBox1").value = FileSys.GetParentPath(dlg.FileName)
Dim dc1 As Col
t1 = Tables(cm2.Text)
t2 = e.form.Controls("Table1").Table
Dim nms1 As String
Dim nms11 As String
Dim cnt1 As Integer = DataTables(cm2.Text).DataCols.Count
Dim Book As New XLS.Book(dz)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
t2.StopRedraw
t2.DataTable.DataRows.clear
Dim zd1 As New Dictionary(Of Integer, String)
For i = 0 To Sheet.Cols.count - 1
If Sheet(0,i).text > ""
r = t2.AddNew()
r("来源字段") = Sheet(0,i).Value
r("来源列数")=i
zd1.Add(r("来源列数"),r("来源字段"))
End If
Next
For Each dc1 In t1.cols
nms1 = nms1 & "|" & dc1.name
t2.cols("接收字段").ComboList = nms1
Next
t2.ResumeRedraw
str1 = e.form.Controls("TextBox1").value
str2 = e.form.Controls("combobox3").value
If str1 = "" Then
Return
End If
For j = 0 To Sheet.Cols.count - 1
If t1.cols.Contains(Sheet(0,j).value) Then
If str = "" Then
str = Sheet(0,j).value
str = str.Replace(" ", "").Trim
Else
str = str & "," & Sheet(0,j).value
str = str.Replace(" ", "").Trim
End If
End If
Next
Dim dr As DataRow
For i = 1 To Sheet.Rows.Count -1
Dim sss As String = ""
prb.Visible = True
prb.Maximum = Sheet.Rows.Count - 1
For Each r In Tables(cm2.Text).Rows
For j = 0 To str.split(",").Length - 1
If sss > "" Then sss = sss & " and "
MessageBox.Show(t2.Rows(j)("来源列数"))
sss = sss & str.split(",")(j) & "=\'" & Sheet(i,t2.Rows(j)("来源列数")).Value & "\'"
Next
Next
dr = DataTables(cm2.Text).find(sss)
If dr Is Nothing Then
r = t1.AddNew()
For j = 0 To str.split(",").Length - 1
r(str.split(",")(j)) = Sheet(i,t2.Rows(j)("来源列数")).Value
Next
t1.DataTable.save
End If
Next
Next
prb.Value = i
MessageBox.Show("数据导入完毕!","温馨提示!")
End If
End With
End If
End If
-- 发布时间：2021/12/31 15:03:00
--
来源列数是不是有些是字符列，有些是数值列？判断一下。根据不同列设置使用还是不使用单引号
表达式中的日期用符号#括起来，数值则不需要任何符号括起来，这些和代码中的格式是一样的，唯一不同的是字符串用单引号括起来。
例如：
Tables("订单").Filter = "[产品] = \'PD01\'" \'字符用单引号括起来
Tables("订单").Filter = "[日期] = #3/17/1999#" \'日期用#括起来
Tables("订单").Filter = "[折扣] = 0.1" \'数值直接使用
-- 发布时间：2021/12/31 16:04:00
-- 回复：（有点蓝）来源列数是不是有些是字符列，有些是...
试着按照老师的提示解决 还是没有得到要领 附上项目 麻烦老师指导下
先选择标题行 样本是前面2行是标题行
然后选择接收表 是项目中已经存在的表
然后选择文件所在目录
自动获取目录下得所有文件 并进行预处理 处理后将文件另存在指定目录下
然后打开 新的文件 然后再实现数据自动和所选择的数据表进行配对导入
当然提示错误如下：【且只完成了一个文件的数据导入 提示错误之后 另外一个文件就不导入了】
想实现目录下的所有Excel表都全部准确导入项目数据中
此主题相关图片如下：1.png
-- 发布时间：2021/12/31 17:14:00
--
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:管理项目1.zip |