From Evernote:

[ACCESS]ACCESSﾌｧｲﾙ内のﾌｫｰﾑ、ﾚﾎﾟｰﾄのデータソースをﾃｷｽﾄファイルで吐き出す。

ACCESSﾌｧｲﾙ内のﾌｫｰﾑ、ﾚﾎﾟｰﾄに埋め込まれているデータソースを調べるのはメンドクサイので、

データソース内容一覧をﾃｷｽﾄファイルで吐き出します。

（９７以降対応）

ﾌｫｰﾑの場合は、それぞれのコントロールを見て、

データソースを持っていれば書き出しています。

'--------------------------------------------------------------------------------

Private Sub Click ()

    Dim motoName As String
    motoName = "データソース" & Format(Today, "ddhhss")
  
    Dim strMdbName As String
  
    SaveModules strMdbName, "", "C:\******.txt"

End Sub

Sub SaveModules (strMdbName As String, strPw As String, strExpFile As String)
  
    Dim dbs As Database
    Set dbs = DBEngine(0)(0)
    Dim docWork As Document
    Dim frm As Form
    Dim rpt As Report

    On Error Resume Next

' リストを出力するファイル名
    'Const FILENAME = strExpFile
  
    Open strExpFile For Output As #100
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, "■     MDB Name : " & strMdbName
    Print #100, "■    CreateDay : " & Now
    Print #100, "■"
    Print #100, "■    Copyright (c) 1997-20xx 7key All Rights Reserved."
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
          
    Print #100, ""
    Print #100, "■■■  FORMS   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    'Set dbs = DBEngine.Workspaces(0).OpenDatabase(strMdbName, False, False, ";PWD=" & strPw)
  
  
    Dim IDX As Long
    For IDX = 0 To dbs.containers!Forms.Documents.Count - 1
        Set docWork = dbs.containers!Forms.Documents(IDX)

        DoCmd ﾌｫｰﾑを開く docWork.Name, A_DESIGN
      
        Set frm = Forms(docWork.Name)
        'If frm.HasModule Then
        'Set mdl = frm.Module
        Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
        Print #100, "□ Module Name : " & docWork.Name
        Print #100, "□     Created : " & docWork.DateCreated
        Print #100, "□    Modified : " & docWork.LastUpdated
        Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
        Print #100, ""
        'Print #100, mdl.Lines(1, mdl.CountOfLines)
      
        Dim IDX2 As Long
        For IDX2 = 1 To frm.Count
            If Len(RTrim(CStr(frm(IDX2 - 1).RowSource))) > 0 Then
                Print #100, "--------------------"
                Print #100, frm(IDX2 - 1).Name
                Print #100, frm(IDX2 - 1).RowSource
                Print #100, "--------------------"
            End If
        Next
          
          
        'End If
        DoCmd 閉じる a_Form, docWork.Name
    Next

    Print #100, ""
    Print #100, ""
    Print #100, "■■■  REPORTS   ■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    Dim IDX3 As Long
    For IDX3 = 0 To dbs.containers!Forms.Documents.Count - 1
        On Error Resume Next
        DoCmd ﾚﾎﾟｰﾄを開く docWork.Name, A_DESIGN
        Set rpt = Reports(docWork.Name)
            'Set mdl = rpt.Module
            Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
            Print #100, "□ Module Name : " & docWork.Name
            Print #100, "□     Created : " & docWork.DateCreated
            Print #100, "□    Modified : " & docWork.LastUpdated
            Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
            Print #100, ""
            Print #100, rpt.RecordSource
        DoCmd 閉じる a_Report, docWork.Name
    Next
  
  
    Close #100
    dbs.Close
    Set dbs = Nothing

End Sub

From Evernote:

[ACCESS→SQLServer]ACCESS内のリンクをVBAではりかえる(DNSver)。

【追記※DNS方式ﾊﾞｰｼﾞｮﾝ】--------------------------------------------

この方法はDNS方式ﾊﾞｰｼﾞｮﾝです。

ローカルＰＣにきちんとODBC設定して行なって使用します。

DNS-LESSﾊﾞｰｼﾞｮﾝはこちら

http://shumitestitblog.blogspot.jp/2012/02/accesssqlserveraccessvba.html

'--------------------------------------------------------

    Dim strDSN As String: strDSN = "systest.aa"

    Dim strDB As String: strDB = "testDB"

    Dim strUser As String: strUser = "user"

    Dim strPass As String: strPass = "pwd"

    Dim TblName As String: TblName = ""

    Dim RemoteTblName As String: RemoteTblName = ""

    '確認(パスワード聞くとかするといいかも)---------------

    rtn = MsgBox("退避ＯＫ？", vbQuestion + vbYesNo, "確認")

    If rtn <> vbYes Then

        Exit Sub

    End If

    

    '実行--------------------------------------

    Dim db As DAO.Database, tb As DAO.TableDef

    Set db = CurrentDb

     For Each tb In db.TableDefs

               

            If tb.Connect <> "" Then 'リンクテーブルだけを処理

                               

                    TblName = tb.Name

                    If Left(tb.Connect, 4) = "Text" Then

                        Dim tmp As String

                        Dim tmp2

                        tmp = tb.SourceTableName

                        tmp2 = split(tmp, ".")

                        RemoteTblName = tmp2(0)

                    Else

                        RemoteTblName = tb.SourceTableName

                    End If

                 

                    '↓チェック=======

                    Dim stADOConnect As String

                    stADOConnect = "Driver={SQL Server};server=" & strDSN & _ 

                                           ";database=" & strDB & _ 

                                           ";uid=" & strUser & ";pwd=" & strPass & ";"

                    Dim ChkFLG As Boolean: ChkFLG = False

                    Dim adoCON As New ADODB.Connection

                    Dim adoRS As ADODB.Recordset

                    Dim mySQL As String

                    adoCON.Open stADOConnect

                    mySQL = "SELECT * FROM dbo.sysobjects " & _ 

                                 " WHERE xtype =N'U' ORDER BY name"

                    Set adoRS = adoCON.Execute(mySQL)

                    Do Until adoRS.EOF = True

                        If RemoteTblName = adoRS!Name Then

                            ChkFLG = True

                            Exit Do

                        End If

                        adoRS.MoveNext

                    Loop

                    adoRS.Close

                    Set adoRS = Nothing

                    adoCON.Close

                    Set adoCON = Nothing

                    '↑チェック=======

                 

                 

                    If ChkFLG = True Then

                        '実行！-----------------------

                        AttachDSNTable TblName, RemoteTblName, strDSN, strDB, strUser, strPass

                    Else

                        'MsgBox("×「" & TblName & "」元の「" & RemoteTblName & _ 

                                    "」テーブルはSQLServerに存在しません。")

                    End If                   

                   

            Else

                'MsgBox ("「" & tb.Name & "」はリンク元なしなのでスルーしました")

            End If

               

    Next tb

   

    RefreshDatabaseWindow

'--------------------------------------------------------

Function AttachDSNTable(stLocalTableName As String, stRemoteTableName As String, stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String)

    On Error GoTo AttachDSNTable_Err

    Dim td As TableDef

    Dim stConnect As String

   

   

    'ここにＯＤＢＣ名

    stConnect = "ODBC;DSN=ここにＯＤＢＣ名;DATABASE=" & stDatabase & ";"

   

   

    '現テーブル削除

    For Each td In CurrentDb.TableDefs

        If td.Name = stLocalTableName Then

            CurrentDb.TableDefs.Delete stLocalTableName

        End If

    Next

    '新テーブル作成

    Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)

    CurrentDb.TableDefs.Append td

    AttachDSNLessTable = True

       

    Exit Function

AttachDSNTable_Err:

   

    AttachDSNTable = False

    MsgBox "AttachDSNTable encountered an unexpected error: " & Err.Description

End Function

'--------------------------------------------------------

ACCESSからSQLServer 変換　移行　VBA  マクロ

From Evernote:

[ACCESS→SQLServer]ACCESS→SQLServerとACCESSの違い

ACCESSのデータテーブルをSQLServerに移管して、そのまま使用する…

と、マクロで色々不都合が起こります。

覚えてるだけまとめてみました。(ACCESS2003での検証です)

--------------------------------------------------------

①主キーは必須。

主キーがないと更新にいけなくなる。

ACCESSの時主キー設定されてなかたのならつける必要がある。

②Yes/No型→bit型にした時の扱い。

クエリを介そうがマクロ直指定だろうがとにかくFalseで問題が起こる。

クエリ、マクロ共々修正の必要がある。

   詳しくは

   http://shumitestitblog.blogspot.jp/2012/02/accesssqlserveryesnobit.html

②date型の扱い。

"yyyy/mm/dd"の型かどうかに注意。

  -------------------------------------------------

  ○ACCESS→" ～WHERE #2012/12.01#"　ＯＫ

  ○SQLServer→" ～WHERE #2012/12.01#"　ＮＧ！→yyyy/mm/dd型に！

  -------------------------------------------------

クエリーを介している場合は問題ないみたいなのだが、　

  マクロで直接上記のようにしてSQL文を投げている場合は修正の必要がある。

ちなみに、

dim Mydate : Mydate = "2012/12.01"　として

Mydate = Cdate(Mydate)

  としてやれば

Mydateは"2012/12/01"と扱われるみたい。

③既定値の扱い。

　テーブル項目の既定値=0としていれば、勝手に0が入るだろ…と思うんですが注意。

  -------------------------------------------------

　RS!単価 = Form!単価　のような時に…

  ○ACCESS→

　Form!単価 = "" なら　→　既定値０が入る

　Form!単価 = Null なら　→　既定値０が入る

　Form!単価 = 3 なら　→　３が入る

  ○SQLServer→

　Form!単価 = "" なら　→　""が入る

　Form!単価 = Null なら　→　Nullが入る

　Form!単価 = 3 なら　→　３が入る

  -------------------------------------------------

結構異なってくる。特に勝手にNullが入られるのは…困る…。

④１桁だけ抜き出してそれを他のテーブルとJOINする場合。

例えば

　-------------------

  Left(管理区分,1) = 親管理No　（両方数値の場合）

　-------------------

  という風に結合していた場合、何故かNG。

Leftを使うことで１度文字列とみなす為かな？

-------------------

  val(Left(管理区分,1) = val(親管理No)

  -------------------

  としてやらなければダメ。

他にもあまりにも複雑なSQL文だとエラーを起こす模様…。

From Evernote:

[ACCESS]ACCESSﾌｧｲﾙ内のクエリ、クエリ内容一覧をﾃｷｽﾄファイルで吐き出す。

ACCESSﾌｧｲﾙ内のクエリ、クエリ内容一覧をﾃｷｽﾄファイルで吐き出します。

（９７以降対応）

'--------------------------------------------------------------------------------
Private Sub CommandButton1_Click()

    Dim motoName As String
    motoName = "クエリ" & Format(Today, "ddhhss")
  
    Dim strMdbName As String
    strMdbName = CurrentDb.Name
  
    SaveModules strMdbName, "", "C:\******.txt"

End Sub


Public Sub SaveModules(strMdbName As String, strPw As String, strExpFile As String)
    Dim dbs As DAO.Database
    Dim objAcc As Access.Application
    Dim mdl As Module
    Dim docWork As DAO.Document
    Dim frm As Form
    Dim rpt As Report

    On Error Resume Next

   
    Open strExpFile For Output As #100
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, "■     MDB Name : " & strMdbName
    Print #100, "■    CreateDay : " & Now
    Print #100, "■"
    Print #100, "■    Copyright (c) 1997-20xx 7key All Rights Reserved."
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    Print #100, "■■■  ｸｴﾘｰ   ■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strMdbName, False, False, ";PWD=" & strPw)
    Set objAcc = GetObject(strMdbName)
  
    For Each qd In dbs.QueryDefs
  
    If Not Left(qd.Name, 1) = "~" Then
        Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
        Print #100, "□        Name : " & qd.Name
        Print #100, "□     Created : " & qd.DateCreated
        Print #100, "□    Modified : " & qd.LastUpdated
        Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
        Print #100, ""
        Print #100, qd.SQL
    End If
  
    Next
  
  
    Close #100
    dbs.Close
    Set dbs = Nothing
    'objAcc.CloseCurrentDatabase
    'Set objAcc = Nothing

End Sub