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


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

主题：移动开发时 上传了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编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | 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
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | 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
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | 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


代码完整如上  运行时所选择的文件都不会保存到指定的目录下    麻烦老师继续指导下
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


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

一个都不弹出来  

 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）没有接收到任何文件，看4楼  发帖心情 Post By：2021/2/26 10:20:00 [显示全部帖子]

还得麻烦老师指导下js代码是否写正确，目前文件还是没有能够成功上传！谢谢！
运行提示上传失败



页面代码：
Dim e As RequestEventArgs = args(0)
Dim wb As New weui
Dim vals As String
wb.AppendHTML("<script>" & vars("ajaxform") & "</script>")
If e.PostValues.Count = 0 Then
    wb.AddPageTitle("","ph1","数据文件上传","数据上传后,后台自动导入数据库!")
    wb.AddForm("","form1","upload1.htm")
    wb.AddTopTips("","toptip1","请选择文件!")
    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= "on cli ck='sub mitForm()'" '调用js函数上传
    .Add("btn2", "取消上传", "submit").FormAction = "default.htm"
    'wb.InsertHTML("<div id='someelement'></div>")
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"
wb.AppendHTML("<script>" & vars("ajaxform") & "</script>")
e.WriteString(wb.Build)
Else
    For Each key As String In e.Files.Keys
        If key = "up1" Then
            For Each fln As String In e.Files(key)
                Dim wj As String =ProjectPath & "Attachments\" & fln
                e.SaveFile(key,fln,wj)
            Next
        End If
        If key = "up2" Then
            For Each fln As String In e.Files(key)
                Dim wj As String =ProjectPath & "Attachments\" & fln
                e.SaveFile(key,fln,wj)
            Next
        End If
    Next
    e.WriteString("OK")
End If

js代码：
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("up1").value && document.getElementById("up2").value ){     ‘红色部分代码怎么修正呢？’
    submitAjaxForm('form1','afterSubmit');
}
else{
show("toptip1",2000);
}
}
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）去掉红色的判断能不能接收文件？  发帖心情 Post By：2021/2/26 10:44:00 [显示全部帖子]

不能   直接提示上传失败   对应的文件夹下无文件

 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）所以说红色代码要不要都没有什么用的...  发帖心情 Post By：2021/2/27 11:58:00 [显示全部帖子]

谢谢  已经按照老师的指导 初步解决了

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.08594 秒, 5 次数据查询