Foxtable(狐表)用户栏目专家坐堂 → 移动开发时 上传了excel文件 怎么写代码后台自动将excel文件的数据导入到对应的表中呢?


  共有2721人关注过本帖树形打印复制链接

主题:移动开发时 上传了excel文件 怎么写代码后台自动将excel文件的数据导入到对应的表中呢?

帅哥哟,离线,有人找我吗?
cnsjroom
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
移动开发时 上传了excel文件 怎么写代码后台自动将excel文件的数据导入到对应的表中呢?  发帖心情 Post By:2021/2/25 16:12:00 [只看该作者]

Select Case e.Path
    Case "upload.htm"
        Dim sb As New StringBuilder
        sb.appendLine("<form enctype='multipart/form-data' action='accept.htm' method='post' id='form1' name='form1'>")
        sb.appendLine(
"
单文件上传: <input type='file' name='up1' id='up1'><br/><br/>")
        sb.appendLine(
"
多文件上传: <input type='file' name='up2' id='up2' multiple><br/><br/>")
        sb.appendLine(
"<input Type='submit' name='Sumbit' id='Sumbit' value='
确定'>")
        sb.appendLine("</form>")
        e.WriteString(sb.ToString)
    Case "accept.htm"
        Dim sb As New StringBuilder
        For Each key As String In e.Files.Keys
            sb.AppendLine(key &
"
上传" & e.Files(key).Count & "个文件,分别是:</br>")
            For Each fl As String In e.Files(key)
                sb.AppendLine(fl & "<br>")
                e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl)
'
保存接收到的文件
           
Next
            sb.AppendLine("</br>")
        Next
        sb.AppendLine("以上文件服务器已正确接收并保存!")
        e.WriteString(sb.ToString)

End
Select

移动开发时  上传了excel文件 怎么写代码后台自动将excel文件的数据导入到对应的表中呢?
参照帮助中的列子  采用上面的代码实现了上传excel等文件

现在假定选择了两个文件  一个是a名单。xls  一个是b名单。xls   
怎么写代码在后台自动将这两个表(直接判断名字中有名单两个字,就自动实现多个文件表一起导入)的数据合并到数据库中的  名单  表里面呢?

下面的代码怎么变通呢?如果直接使用,在页面端无法出现选择,在服务端可以弹出对话框进行操作

示例八

下面是一个批量合并的例子,假定目录c:\data下有多个Excel文件,这些文件都有一个名为订单的表,需要将这些表中的数据批量并到Foxtable的订单表中:

For Each fl As String In FileSys.GetFiles("c:\Data")
    Dim
mg As
New Merger
    mg.SourcePath = fl
    mg.Format =
"excel" '指定格式
    mg.SourceTableName =
"订单" '指定要合并的表
    mg.DataTableName =
"订单" '指定接收数据的表
    mg.Merge()
'开始合并
Next

示例九

也可以利用打开文件对话框一次选择多个文件来批量合并,例如:

Dim dlg As New OpenFileDialog
dlg
.Filter = "Access文件|*.mdb"
dlg
.MultiSelect = True '允许选择多个文件
If
dlg.ShowDialog =DialogResult.OK Then
    For Each
fl As String In dlg.FileNames
        Dim
mg As New Merger
       
mg.SourcePath = fl
       
mg.SourceTableName = "订单"
       
mg.DataTableName = "订单"
       
mg.Merge()
    Next
End If

[此贴子已经被作者于2021/2/25 16:14:38编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/2/25 16:25:00 [只看该作者]

      For Each fl As String In e.Files(key)
                sb.AppendLine(fl & "<br>")
                e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl) 
'
保存接收到的文件
    Dim mg As New Merger
    mg.SourcePath = "d:\web\uploadfiles\" & fl
    mg.Format = 
"excel" '指定格式
    mg.SourceTableName = 
"订单" '指定要合并的表
    mg.DataTableName = 
"订单" '指定接收数据的表
    mg.Merge() 
'开始合并
            
Next

 回到顶部
帅哥哟,离线,有人找我吗?
cnsjroom
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
回复:(有点蓝)      For ...  发帖心情 Post By:2021/2/25 16:48:00 [只看该作者]

有点蓝老师,参照更新后无法进行提交上传,

图片点击可在新窗口打开查看此主题相关图片如下:1111.png
图片点击可在新窗口打开查看
点击确定上传,没有上传成功文件,麻烦帮忙看看js代码红色部分如何修正

js名
upload  其代码如下:
function afterSubmit(result){
    hide("tst1");
    if (result=='OK') {
        show("tst2");
        location="upload.htm";
    }
    else{
        show("tst3",2000);
    }
}


function submitForm(){
    show("tst1",2000);
if (document.getElementById("dw").value && document.getElementById("bj").value ){     ‘红色部分代码怎么修正呢?’
    submitAjaxForm('form1','afterSubmit');
}
else{
show("toptip1",2000);
}
}

upload页面代码如下:
Dim e As RequestEventArgs = args(0)
Dim wb As New weui

Dim vals As String
wb.AppendHTML("<script>" & vars("upload") & "</script>")
If e.PostValues.Count = 0 Then
    wb.AddPageTitle("","ph1","数据文件上传","数据上传后,后台自动导入数据库!")
    wb.AddForm("","form1","upload.htm") 
    Dim sb As New StringBuilder
    sb.appendLine("<div>")
    sb.appendLine("单文件上传: <input type='file' name='up1' id='up1'><br/>")
    sb.appendLine("多文件上传: <input type='file' name='up2' id='up2' multiple>")
    sb.appendLine("</div>")
    wb.InsertHTML("form1",sb.ToString)
With wb.AddButtonGroup("form1","btg1",False)   
    .Add("btn1", "确定上传", "button").Attribute= "" '调用js函数上传
    .Add("btn2", "取消上传", "submit").FormAction = "default.htm"
End With


With wb.AddDialog("","dlg1", "增加成功","好好学习,天天向上!")
    .AddButton("btnOK","继续增加","default.htm")
End With
wb.AddToast("","tst1", "正在上传",1)
wb.AddToast("","tst2", "上传成功",0)
wb.AddToast("","tst3", "上传失败",0).Icon= "warn"
e.WriteString(wb.Build)
Else    
Dim sb As New StringBuilder
    For Each key As String In e.Files.Keys
        If key = "up1" Then
    For Each fl As String In e.Files(key)
        sb.AppendLine(fl & "<br>")
        e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl) '保存接收到的文件
        Dim mg As New Merger
        mg.SourcePath = "d:\web\uploadfiles\" & fl
        mg.Format = "excel" '指定格式
        mg.SourceTableName = "表彰" '指定要合并的表
        mg.DataTableName = "表彰" '指定接收数据的表
        mg.Merge() '开始合并
    Next
        End If
        If key = "up2" Then
    For Each fl As String In e.Files(key)
        sb.AppendLine(fl & "<br>")
        e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl) '保存接收到的文件
        Dim mg As New Merger
        mg.SourcePath = "d:\web\uploadfiles\" & fl
        mg.Format = "excel" '指定格式
        mg.SourceTableName = "表彰" '指定要合并的表
        mg.DataTableName = "表彰" '指定接收数据的表
        mg.Merge() '开始合并
    Next
        End If
    Next
    e.WriteString("OK")
End If

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/2/25 17:23:00 [只看该作者]

如果使用html自带的文件功能就麻烦了,要自己使用ajax上传:https://www.baidu.com/s?wd=js%20%E4%B8%8A%E4%BC%A0%E8%A1%A8%E5%8D%95%E5%92%8C%E6%96%87%E4%BB%B6

 回到顶部
帅哥哟,离线,有人找我吗?
cnsjroom
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
回复:(有点蓝)如果使用html自带的文件功能就麻烦了...  发帖心情 Post By:2021/2/26 0:35:00 [只看该作者]

写成这样也没有实现上传后自动合并数据 
麻烦老师帮忙看看

Dim e As RequestEventArgs = args(0)
  Dim wb As New weui

 If e.PostValues.Count = 0 Then
            wb.AddForm("","form1","upload.htm")
            With wb.AddInputGroup("form1","ipg1","选择文件上传后台自动导入数据")
                .AddUploader("up1","文件",True) 'True表示允许上传多个文件
            End With
            With wb.AddButtonGroup("form1","btg1",True)
                .Add("btn1", "确定", "submit")
            End With
            e.WriteString(wb.Build)
        Else

    For Each key As String In e.Files.Keys
        If key = "up1" Then
    For Each fl As String In e.Files(key)
        
        e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl) '保存接收到的文件
        Dim mg As New Merger
        mg.SourcePath = "d:\web\uploadfiles\" & fl
        mg.Format = "excel" '指定格式
        mg.SourceTableName = "表彰" '指定要合并的表                             
        mg.DataTableName = "表彰" '指定接收数据的表
        mg.Merge() '开始合并
    Next
        End If
next
  With wb.AddMsgPage("","msgpage","增加成功", "好好学习,天天向上") '生成成功提示页
                .AddButton("btn1","继续增加","upload.htm")
            End With
            e.WriteString(wb.Build)
        End If

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/2/26 8:49:00 [只看该作者]

调试看看

    For Each key As String In e.Files.Keys
        If key = "up1" Then
    For Each fl As String In e.Files(key)
        msgbox(fl)
        e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl) '保存接收到的文件
msgbox(FileSys.FileExists("d:\web\uploadfiles\" & fl))
        Dim mg As New Merger
        mg.SourcePath = "d:\web\uploadfiles\" & fl
        mg.Format = "excel" '指定格式
        mg.SourceTableName = "表彰$" '指定要合并的表                             
        mg.DataTableName = "表彰" '指定接收数据的表
        mg.Merge() '开始合并
datatables("表彰").save
    Next
        End If
next

另外看看execl有没有符合格式:http://www.foxtable.com/webhelp/topics/2280.htm
有没有和表彰表有相同的列名



 回到顶部
帅哥哟,离线,有人找我吗?
cnsjroom
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
回复:(有点蓝)调试看看    For Each key...  发帖心情 Post By:2021/2/26 9:07:00 [只看该作者]

Dim wb As New weui

If e.PostValues.Count = 0 Then
    wb.AddForm("","form1","upload.htm")
    With wb.AddInputGroup("form1","ipg1","选择文件上传后台自动导入数据")
        .AddUploader("up1","文件",True) 'True表示允许上传多个文件
    End With
    With wb.AddButtonGroup("form1","btg1",True)
        .Add("btn1", "确定", "submit")
    End With
    e.WriteString(wb.Build)
Else
    msgbox("1")
    For Each key As String In e.Files.Keys
        If key = "up1" Then
            For Each fl As String In e.Files(key)
                msgbox(fl)
                e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl) '保存接收到的文件
                msgbox(FileSys.FileExists("d:\web\uploadfiles\" & fl))
                Dim mg As New Merger
                mg.SourcePath = "d:\web\uploadfiles\" & fl
                mg.Format = "excel" '指定格式
                mg.SourceTableName = "表彰$" '指定要合并的表
                mg.DataTableName = "表彰" '指定接收数据的表
                mg.Merge() '开始合并
                DataTables("表彰").save
            Next
        End If
    Next
    With wb.AddMsgPage("","msgpage","增加成功", "好好学习,天天向上") '生成成功提示页
        .AddButton("btn1","继续增加","upload.htm")
    End With
    e.WriteString(wb.Build)
End If


代码完整如上  运行时所选择的文件都不会保存到指定的目录下    麻烦老师继续指导下

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/2/26 9:16:00 [只看该作者]

Else
    msgbox("1")
    For Each key As String In e.Files.Keys
                msgbox( key) 能不能弹出
        If key = "up1" Then
            For Each fl As String In e.Files(key)
                msgbox(fl) 能不能弹出
                e.SaveFile(key,fl,"d:\web\uploadfiles\" & fl) '保存接收到的文件
                msgbox(FileSys.FileExists("d:\web\uploadfiles\" & fl)) 能不能弹出
                Dim mg As New Merger
                mg.SourcePath = "d:\web\uploadfiles\" & fl
                mg.Format = "excel" '指定格式
                mg.SourceTableName = "表彰$" '指定要合并的表
                mg.DataTableName = "表彰" '指定接收数据的表
                mg.Merge() '开始合并
                DataTables("表彰").save
            Next

 回到顶部
帅哥哟,离线,有人找我吗?
cnsjroom
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
回复:(有点蓝)Else    msgbox("1") ...  发帖心情 Post By:2021/2/26 9:24:00 [只看该作者]

一个都不弹出来  

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:105473 积分:536350 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/2/26 9:25:00 [只看该作者]

没有接收到任何文件,看4楼

 回到顶部
总数 15 1 2 下一页