vba,excel,wps,sql保存服务器

最新推荐文章于 2023-06-01 18:04:46 发布
最新推荐文章于 2023-06-01 18:04:46 发布
阅读量426 收藏 1
点赞数 1
文章标签： 数据库
原文链接：http://www.cnblogs.com/--3q/p/11444743.html
版权

vba，excel ，wps,sql保存服务器2019-09-02

参考地址12:02:11   特别注意 双引号下的变量 看看转义的手法    SQL = " Select * from [" & wsName & "]"

 http://club.excelhome.net/thread-859194-1-1.html

Option Private Module
'Public Const ID As String = "WIN-OM179101SM0\sqlexpress"  '数据库服务器名称
Public Const ID As String = "WIN-OM179101SM0"
Public Const DataBase As String = "demo"          '数据库名称
Public Const UserName As String = "sa"            '数据库连接用户名
Public Const PassWord As String = "11111111"  '数据库连接密码


Sub ExcelToServer()
    Dim cn As New ADODB.Connection, i%, j%, strTable$, n
    Dim rs As New ADODB.Recordset
    Dim cnStr As String, SQL As String, wsName$
    wsName = ActiveSheet.Name
    'Cells(1, 5).Value = wsName
    On Error GoTo errHandle
    cnStr = "Provider=sqloledb;Server=" & ID & ";Database=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & ";"
    cn.ConnectionTimeout = 10
    cn.Open cnStr
    SQL = "if exists(select * from sysobjects where name='" & wsName & "') drop table " & wsName
    i = Cells(1, 16384).End(xlToLeft).Column
    strTable = " create table " & wsName & "("
    For j = 1 To i
        If Cells(1, j).Value = "" Then
            MsgBox "检测到标题行存在空值，导入失败！", vbInformation, "提醒"
            Exit Sub
        Else
            If j = 1 Then
                strTable = strTable & Cells(1, j).Value & " varchar(100) null"
            Else
                strTable = strTable & "," & Cells(1, j).Value & " varchar(100) null"
            End If
        End If
    Next
    SQL = SQL & strTable & ")"
    
    Set rs = cn.Execute(SQL)  '删除数据库同名数据表
    If rs.State = adStateOpen Then rs.Close
    If cn.State = adStateOpen Then cn.Close
    
    
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    cn.Open cnStr
    SQL = "insert into [odbc;Driver={SQL Server};Server=" & ID & ";DataBase=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & "].[" & wsName & "] Select * from [" & wsName & "$]"
    Set rs = cn.Execute(SQL, n)
    If n > 0 Then
        MsgBox "成功上传" & n & "条数据到数据库!", vbInformation, "提醒"
    Else
        MsgBox "没导入数据！"
    End If
    If rs.State = adStateOpen Then rs.Close
    If cn.State = adStateOpen Then cn.Close
    Exit Sub
errHandle:
    MsgBox "数据库连接失败或者发生不可预料的错误！错误号:" & Err.Number & ",错误信息:" & Err.Description, vbInformation, "提醒您"
End Sub

　　

 

表格名 就是 数据库表名

.

 查询  普通版

 

Sub ExcelToServer()
    Dim ID As String
    ID = "WIN-OM179101SM0" '数据库名称'Public Const ID As String = "WIN-OM179101SM0\sqlexpress"  '数据库服务器名称
       Dim DataBase As String
    DataBase = "demo" '数据库名
       Dim UserName As String
    UserName = "sa" '数据库连接用户名
       Dim PassWord As String
    PassWord = "11111111" '数据库连接密码
    
    
    Dim cn As New ADODB.Connection, i%, j%, strTable$, n
    Dim rs As New ADODB.Recordset
    Dim cnStr As String, SQL As String, wsName$
    wsName = ActiveSheet.Name
    'Cells(1, 5).Value = wsName
    On Error GoTo errHandle
    cnStr = "Provider=sqloledb;Server=" & ID & ";Database=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & ";"
    cn.ConnectionTimeout = 10
    cn.Open cnStr
    SQL = "if exists(select * from sysobjects where name='" & wsName & "') drop table " & wsName
    i = Cells(1, 16384).End(xlToLeft).Column
    strTable = " create table " & wsName & "("
    For j = 1 To i
        If Cells(1, j).Value = "" Then
            MsgBox "检测到标题行存在空值，导入失败！", vbInformation, "提醒"
            Exit Sub
        Else
            If j = 1 Then
                strTable = strTable & Cells(1, j).Value & " varchar(100) null"
            Else
                strTable = strTable & "," & Cells(1, j).Value & " varchar(100) null"
            End If
        End If
    Next
    SQL = SQL & strTable & ")"
    
    Set rs = cn.Execute(SQL)  '删除数据库同名数据表
    If rs.State = adStateOpen Then rs.Close
    If cn.State = adStateOpen Then cn.Close
    
    
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    cn.Open cnStr
    SQL = "insert into [odbc;Driver={SQL Server};Server=" & ID & ";DataBase=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & "].[" & wsName & "] Select * from [" & wsName & "$]"
    Set rs = cn.Execute(SQL, n)
    If n > 0 Then
        MsgBox "成功上传" & n & "条数据到数据库!", vbInformation, "提醒"
    Else
        MsgBox "没导入数据！"
    End If
    If rs.State = adStateOpen Then rs.Close
    If cn.State = adStateOpen Then cn.Close
    Exit Sub
errHandle:
    MsgBox "数据库连接失败或者发生不可预料的错误！错误号:" & Err.Number & ",错误信息:" & Err.Description, vbInformation, "提醒您"
End Sub

Sub 查询sql()
   ID = "WIN-OM179101SM0" '数据库名称'Public Const ID As String = "WIN-OM179101SM0\sqlexpress"  '数据库服务器名称
       Dim DataBase As String
    DataBase = "demo" '数据库名
       Dim UserName As String
    UserName = "sa" '数据库连接用户名
       Dim PassWord As String
    PassWord = "11111111" '数据库连接密码


'On Error Resume Next       '如果出现错误，忽略，然后执行下一行代码。
Application.ScreenUpdating = False '关闭屏幕刷新,成对出现，提高速度
Application.DisplayAlerts = False '关闭提示，,成对出现，避免出现提示框
    wsName = "excxl_sql_1"
    Dim cn As New ADODB.Connection, i%, j%
    Dim rs As New ADODB.Recordset
    Dim cnStr As String, SQL As String
    

      cnStr = "Provider=sqloledb;Server=" & ID & ";Database=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & ";"
    cn.ConnectionTimeout = 10
    cn.Open cnStr
    
    SQL = " Select * from [" & wsName & "]"
    
    Set rs = cn.Execute(SQL)

   Sheets("查询结果").Cells.ClearContents '清理保存数据的区域
   Sheets("查询结果").Range("a2").CopyFromRecordset rs '粘贴表格
  
Application.ScreenUpdating = True '关闭屏幕刷新,成对出现，提高速度
Application.DisplayAlerts = True '关闭提示，,成对出现，避免出现提示框
    If rs.State = adStateOpen Then rs.Close ' 关闭结果缓存
    If cn.State = adStateOpen Then cn.Close '关闭数据库
    Exit Sub
End Sub

　　

 

查询 高级版  用公共函数  改密码 只需改一次  应用的时候 宏列表是没有显示的  需要    文件名！宏函数名

 

 

Option Private Module
'Public Const ID As String = "WIN-OM179101SM0\sqlexpress"  '数据库服务器名称
Public Const ID As String = "WIN-OM179101SM0"
Public Const DataBase As String = "demo"          '数据库名称
Public Const UserName As String = "sa"            '数据库连接用户名
Public Const PassWord As String = "11111111"  '数据库连接密码


Sub ExcelToServer()
    Dim cn As New ADODB.Connection, i%, j%, strTable$, n
    Dim rs As New ADODB.Recordset
    Dim cnStr As String, SQL As String, wsName$
    wsName = ActiveSheet.Name
    'Cells(1, 5).Value = wsName
    On Error GoTo errHandle
    cnStr = "Provider=sqloledb;Server=" & ID & ";Database=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & ";"
    cn.ConnectionTimeout = 10
    cn.Open cnStr
    SQL = "if exists(select * from sysobjects where name='" & wsName & "') drop table " & wsName
    i = Cells(1, 16384).End(xlToLeft).Column
    strTable = " create table " & wsName & "("
    For j = 1 To i
        If Cells(1, j).Value = "" Then
            MsgBox "检测到标题行存在空值，导入失败！", vbInformation, "提醒"
            Exit Sub
        Else
            If j = 1 Then
                strTable = strTable & Cells(1, j).Value & " varchar(100) null"
            Else
                strTable = strTable & "," & Cells(1, j).Value & " varchar(100) null"
            End If
        End If
    Next
    SQL = SQL & strTable & ")"
    
    Set rs = cn.Execute(SQL)  '删除数据库同名数据表
    If rs.State = adStateOpen Then rs.Close
    If cn.State = adStateOpen Then cn.Close
    
    
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    cn.Open cnStr
    SQL = "insert into [odbc;Driver={SQL Server};Server=" & ID & ";DataBase=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & "].[" & wsName & "] Select * from [" & wsName & "$]"
    Set rs = cn.Execute(SQL, n)
    If n > 0 Then
        MsgBox "成功上传" & n & "条数据到数据库!", vbInformation, "提醒"
    Else
        MsgBox "没导入数据！"
    End If
    If rs.State = adStateOpen Then rs.Close
    If cn.State = adStateOpen Then cn.Close
    Exit Sub
errHandle:
    MsgBox "数据库连接失败或者发生不可预料的错误！错误号:" & Err.Number & ",错误信息:" & Err.Description, vbInformation, "提醒您"
End Sub

Sub 查询sql()
'On Error Resume Next       '如果出现错误，忽略，然后执行下一行代码。
Application.ScreenUpdating = False '关闭屏幕刷新,成对出现，提高速度
Application.DisplayAlerts = False '关闭提示，,成对出现，避免出现提示框
    wsName = "excxl_sql_1"
    Dim cn As New ADODB.Connection, i%, j%
    Dim rs As New ADODB.Recordset
    Dim cnStr As String, SQL As String
    

      cnStr = "Provider=sqloledb;Server=" & ID & ";Database=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & ";"
    cn.ConnectionTimeout = 10
    cn.Open cnStr
    
    SQL = " Select * from [" & wsName & "]"
    
    Set rs = cn.Execute(SQL)

   Sheets("查询结果").Cells.ClearContents '清理保存数据的区域
   Sheets("查询结果").Range("a2").CopyFromRecordset rs '粘贴表格
  
Application.ScreenUpdating = True '关闭屏幕刷新,成对出现，提高速度
Application.DisplayAlerts = True '关闭提示，,成对出现，避免出现提示框
    If rs.State = adStateOpen Then rs.Close ' 关闭结果缓存
    If cn.State = adStateOpen Then cn.Close '关闭数据库
    Exit Sub
End Sub

　　

转载于:https://www.cnblogs.com/--3q/p/11444743.html

aloyz64466
关注
  • 1
    点赞
  • 踩
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
WPS支持VBA 7.1版本 VBA For WPS
08-21
WPS支持VBA 7.1版本 VBA For WPS
vba可以放服务器上处理文档,vba 用服务器运行 内存溢出
weixin_36247139的博客
08-06 462
vba 用服务器运行 内存溢出 内容精选换一换一个完整的AI CPU算子包含四部分：算子原型定义、对应开源框架的算子适配插件、算子信息库定义和算子实现。算子开发完成后在昇腾AI处理器硬件平台上的编译运行逻辑架构如图1所示。其中，TFAdapter只有在基于Tensorflow框架进行训练时使用。上图中圆柱形图示为开发人员在自定义算子开发时需要实现的交付件。AI CPU算子的编译详细流园区智能体的算...
WPS表格使用VBA链接SQLServer读取数据
lzxb08的博客
06-01 1624
此代码在WPS表格中运行正常，office Excel中没有测试过，用的都是WPS所以…需要提前安装WPS VBA插件否则无法运行。
vba向服务器上传文件,使用multer模块上传文件到服务器
weixin_29785723的博客
08-09 611
首先,我们需要一个form表单,用来提交数据.Documentfile:然后我们需要一个js文件const express=require('express');const bodyParser=require('body-parser');const server=express();server.listen(3000,function(err){if(!err){console.log('s...
Vba在服务器上生成文件目录,自己编写了一个自动生成目录下文件夹及文件的程序！...
weixin_33810114的博客
08-10 844
Sub AutoWriteRecord()Dim ThisWorkbook As Workbook, ThisWorksheet As WorksheetDim CreatingRange As Range, DataRange As Range, CreatingArray() As VariantDim i As Long, j As Long, k As Long, TotalNum As ...
VBA 7.1 FOR WPS 2019
10-30
适用于安装 WPS 2019 版本的 缺少 VBA 模块的 亲测可用，内含 VBA 7.1 安装顺序1、2、3、4按照顺序安装；
Excel VBA+SQL 数据管理与应用模板开发.rar
12-08
利用EXCEL VBA+SQL数据库开发常用的办公模板，代码未加密，可以直接复制和使用！欢迎下载！
VBA WPSVBA WPSVBA WPS
04-17
VBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA WPSVBA ...
Excel VBA函数生成SQL
07-31
Excel VBA函数生成SQL
VBA访问远程Excel
08-31
简单的VBA访问远程Excel程序，原理是将远程文件夹映射到本地盘符。
WPS.vba宏启用自动生成GenerateDBSql
07-15
WPS.vba宏启用自动生成GenerateDBSql
WPS表格中使用SQL语句获取动态列
qq_39330713的博客
08-03 6809
更新语句 ="update zj_zhxx set f_zhzt='0' where f_zh='"&TRIM(H27)&"';" 黑色字体为需要获取数据的动态列，可根据需要
WPS表格使用VBA往SQLServer中写入数据
最新发布
lzxb08的博客
06-01 635
此代码在WPS表格中运行正常，office Excel中没有测试过，用的都是WPS所以…需要提前安装WPS VBA插件否则无法运行。A1处如果去掉注释则每次都会清空数据表再写入。否则就是每次执行都会继续向数据表中插入数据。
wps技巧：excel记录转sql语句
Quan的博客
12-31 7025
1.excel记录转sql语句 1.1.CONCATENATE 总会有些情况需要将excel文档的数据录入数据库中，当然我们也不想一条条地手敲进去，毕竟这样的效率实在是太慢了。这里推荐使用一个简单的将excel数据转sql语句的方法： excel数据表 选中D1区，在fx的框中输入： =CONCATENATE("insert into USER(SYSTEMID,CARDTYPE,NAME) values(sys_guid(),'"&B1&"', '"&amp...
【MySQL】用 WPS（SqlCel不推荐，另外一种做法） 或 Excel（SqlCel） 的列数据作为查询条件去 MySQL 查询的操作
weixin_50223520的博客
04-19 748
将Excel的列数据作为查询条件去MySQL查询的操作
wps连接mysql odbc_如何在WPS中使用ADO连接数据库？
weixin_34501965的博客
01-20 4372
现在数据量越来越大，想实现VBA+ADO。因为单位使用WPS居多。编写的代码语句在office2016中能顺利运行并提取到数据，但是在WPS2019(已安装宏)中无法运行。于是从http://club.excelhome.net/thread-1432952-4-1.html了解到可能还需要安装插件，所以到了微软官网下载了【Microsoft Access 2016 数据库引擎可再发行程序包】，最...
WPS导入SQLSERVER的数据
热门推荐
lgxrobot的博客
07-04 1万+
WPS2019导入SQLSERVER 2008 R2的数据 用SQLSERVER直接导出EXCEL老是容易报错，导出不成功，导出的身份证格式老是有些不对，所以考虑用其他方法来解决这个问题，这次用WPS来导入SQLSERVER的数据。 1、打开WPS->点击表格->新建空白文档 2、单击数据->导入数据 3、选择数据源->其他/高级->下一步 4、提供程序选择M...
用WPS的vlookup进行左关联，类似SQL的left join
ccn0516的博客
06-06 1989
两个EXCEL表进行匹配
excel vba sql
03-31
Excel VBA SQL refers to the use of Structured Query Language (SQL) in Microsoft Excel's Visual Basic for Applications (VBA) programming language. With Excel VBA SQL, developers can write SQL queries...

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值