access vba 別ファイルのデータをインサート
Public Sub tensou()
On Error GoTo E
Dim myDB As Database
Dim myTD As TableDef
'カレントデータベースを変数に代入する
Set myDB = CurrentDb
'データベース内のテーブル名前を表示する
For Each myTD In myDB.TableDefs
'別ファイルのテーブル名からデータを転送する
If Left(myTD.Name, 4) <> "MSys" Then
Debug.Print myTD.Name
CurrentDb.Execute "INSERT INTO " & myTD.Name & " SELECT * FROM " & myTD.Name & " IN 'D:\work\sample.mdb';"
End If
Next
ExitSub:
MsgBox ("おわり")
Exit Sub
E:
MsgBox Err.Description
Resume ExitSub
End Sub
access vba dbfインポート
Option Compare Database
'dbfインポート
Function import_dbf()
Dim Path As String
Dim buf As String, f As Object
Path = InputBox$("dbf格納フォルダ")
buf = Dir(Path & "\*.dbf")
Do While buf <> ""
Debug.Print (Path & "\" & buf)
'テーブルの存在確認
If ExistTable(Replace(buf, ".dbf", "")) Then
'テーブルをドロップ
DoCmd.DeleteObject acTable, Replace(buf, ".dbf", "")
End If
DoCmd.TransferDatabase acImport, "dBase IV", Path, acTable, buf, Replace(buf, ".dbf", "")
buf = Dir()
Loop
msgbox("おわり")
Exit_import_dbf:
Exit Function
Err_import_dbf:
Debug.Print (Err.Description)
MsgBox buf & vbCrLf & Err.Number & " - " & Err.Description
Resume Exit_import_dbf
End Function
'テーブルの存在確認
Public Function ExistTable(TableName As String) As Boolean
On Error Resume Next
ExistTable = CurrentDb.TableDefs(TableName).Name = TableName
End Function
access vba フィールド型変換
Option Compare Database
Function alterFields()
Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim sql As String
Set cn = CurrentProject.Connection
cmd.ActiveConnection = cn
sql = "ALTER TABLE [テーブル名] ALTER COLUMN [カラム名] TEXT(50)"
cmd.CommandText = sql
cmd.Execute
MsgBox ("OK")
alterFields = ""
End Function
Access Excel列番号 列名 変換
'列番号を文字に変換するユーザー定義関数
Function ColNum2Txt(lngColNum As Long) As String
On Error GoTo ErrHandler
Dim strAddr As String
strAddr = Cells(1, lngColNum).Address(False, False)
ColNum2Txt = Left(strAddr, Len(strAddr) - 1)
Exit Function
ErrHandler:
ColNum2Txt = ""
End Function
