设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2203|回复: 2
打印 上一主题 下一主题

[模块/函数] 不知为什么不能重新命名新建文件夹,语句哪里有问题?

[复制链接]
跳转到指定楼层
1#
发表于 2014-2-8 10:10:20 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
Private Sub 全部导出_Click()
    Dim myFSO As New FileSystemObject
    Dim myFolder As String
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset
    Dim sql1 As String, sql2 As String
    Dim i As Long, j As Long
    Dim myfile As String
    myFolder = GetFolder

    sql1 = "SELECT 业务员 FROM 结算 GROUP BY 业务员;"
    rs1.Open sql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic


    For i = 1 To rs1.RecordCount
        myfile = rs1("业务员") & ".xls"

        '每100个另选文件夹
        If i Mod 100 = 0 Then
            myFolder = GetFolder
        End If

        '        '其实如文件很多,不如设一个编号的文件夹,比较方便,不用另选。如:
        '        If i Mod 100 = 0 Then
        '            myFolder = myFolder & i
        '        End If

        If myFSO.FileExists(myFolder & "\" & myfile) = False Then
            Call CreatE(myfile, myFolder)
        End If

        sql2 = "SELECT * FROM 结算 where 业务员='" & rs1("业务员") & "'"
        rs2.Open sql2, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

        Set xlApp = CreateObject("Excel.Application")
        xlApp.Application.Visible = True
        Set xlBook = xlApp.Workbooks.Open(myFolder & "\" & myfile)

   
    '导出主表
    xlBook.Application.Sheets(1).Select
    xlBook.Application.Range("A1").Value = "姓 名:"
    xlBook.Application.Range("B1").Value = rs1("业务员")
   
   
    xlBook.Application.Range("A2").Value = "回款日期"
    xlBook.Application.Range("b2").Value = "厂名"
    xlBook.Application.Range("c2").Value = "回款类别"
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

2#
发表于 2014-2-8 11:03:03 | 只看该作者
请说明具体哪句代码出错? 或上传相关的文件,大家才好帮你调试
3#
 楼主| 发表于 2014-2-8 11:32:26 | 只看该作者
谢谢管理员! 主要在这段语句中,另选文件夹不能命名
    Set xlBook = xlApp.Workbooks.Open(myFolder & "\" & myfile)

您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-18 03:37 , Processed in 0.068683 second(s), 26 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表