批量将CSV导入access
alt+f11 打开access的vbe环境
Sub test()
Dim SQL As String
Dim MyPath As String
Dim MyPathDb As String
Dim MyFile As String
MyPath = "D:\temp\*.CSV"
MyPathDb = "D:\temp"
MyFile = Dir(MyPath)
Do
SQL = "insert into 110 select * from [Text;DATABASE=" & MyPathDb & "].[" & MyFile & "]"
DoCmd.RunSQL SQL
'Debug.Print MyFile
MyFile = Dir
Loop Until MyFile = ""
DoCmd.SetWarnings True
End Sub
直接运行此函数即可
1.根据日期返回星期:=TEXT(A2,"aaaa") A2中为日期
2.提取文本超链接放到后一列,以下代码的作用就是把文本下的链接提取,并放在后面1列。
Sub 提取链接()
Dim HL AsHyperlink
For Each HL InActiveSheet.Hyperlinks
HL.Range.Offset(0, 1).Value = HL.Address‘就是说把链接放在非单独链接的后面一列。
Next
End Sub
3.检测单元格变动(变动后着色)
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox ("changed")
Target.Interior.ColorIndex = 3
Target.Font.ColorIndexf = 4
End Sub
4.操作其它excel的sheet
Private Sub CommandButton1_Click()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
flag = 0
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
'MsgBox MyPath
MyName = Dir(MyPath & "\" & "*.xls")
' MsgBox MyName
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
'MsgBox "正在处理第" & Num & "个工作表,名字是:" & Wb.Name
'If Wb.Sheets(3).Name = "签约" Then
With Workbooks(1).Worksheets(1)
' MsgBox Workbooks(1).Worksheets(1).Name
'wb.sheets(“xxx”).usedrange.copy 报错
Wb.Sheets("签约").Range("a1:L65535").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
.UsedRange.Rows.AutoFit
.UsedRange.Columns.AutoFit
End With
' End If
flag = 1
WbN = WbN & Chr(13) & Wb.Name
Wb.Close SaveChanges:=0
' End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
End Sub