コードによるコピー操作  
objFSO.CopyFile str元ファイル, str新ファイル, True
Set objFSO = Nothing
下記のエラーが発生時





コピー先の容量が少ない時にエラーが発生
   ADOXで使用時、リンクテーブルは使用不可
  ADOXで、動作する時は、非連結テーブルであること

  Accessで、SQLを組み立てるときに、取り扱う文字列に「'」（＝シングルクオーテーション、アポストロフィー）が入っていると、エラーになる。  

 スピンボタンの書き方 スピンボタンとは、フォームのテキストボックスの値を上下させるボタンのことです。
通常のツールボックス （ラベルやリストボックスなどのコントロールのかたまり） には入っていません。

どうやってフォームに貼り付けるかというと、フォームをデザインで開いて、
メニューのツール →
ActiveXコントロール →
Microsoft Froms 2.0 SpinButton
を、ドラッグします。

スピンボタンのイベントにアクションを設定しても何にも動かないのですが、コードに無理矢理記述してやると動作するようになります。

Private Sub XXXXXXX_SpinUp()
End Sub

Private Sub XXXXXXX_SpinDown()
End Sub

・・・というように書きます。
（XXXXXXX がスピンボタンの名前です）

以下、サンプル。

'■■■■■■■■■■■
'日付の場合
'■■■■■■■■■■■
'----------------------
'上ボタンを押した時
'----------------------
Private Sub spnDate_SpinUp()
'上下範囲14日以内に制限

txtDate.Value = txtDate.Value + 1
If txtDate.Value > Now() + 14 Then
txtDate.Value = Now() + 14
End If

End Sub

'----------------------
'下ボタンを押した時
'----------------------
Private Sub spnDate_SpinDown()
'上下範囲14日以内に制限

txtDate.Value = txtDate.Value - 1
If txtDate.Value < Now() - 14 Then
txtDate.Value = Now() - 14
End If

End Sub




'■■■■■■■■■■■
'数値の場合
'■■■■■■■■■■■
'----------------------
'上ボタンを押した時
'----------------------
Private Sub spnData_SpinUp()
'上限値=100に設定

txtData.Value = txtData.Value + 1
If txtData.Value > 100 Then
txtData.Value = 100
End If

End Sub

'----------------------
'下ボタンを押した時
'----------------------
Private Sub spnDate_SpinDown()
'下限値=1に設定

txtData.Value = txtData.Value - 1
If txtData.Value < 1 Then
txtData.Value = 1
End If
   外部ＤＢとの接続チエック Dim CN As New ADODB.Connection
Set CN = CurrentProject.Connection

Dim rsx As New ADODB.Recordset
Dim con2 As New ADODB.Connection

Dim z As String
Dim FileName As String
Dim p As Long

Set con2 = New ADODB.Connection
Set rsx = New ADODB.Recordset
rsx.Open "SELECT * from 対象 ", CN, , , adCmdText
z = rsx.Fields("対象")


FileName = z
p = InStrRev(FileName, "\")

If Mid(FileName, p + 1) <> "ボランテア管理DB.mdb" Then
MsgBox "接続するフアイル名が間違っています"
Exit Sub
End If

con2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & z

On Error GoTo Err

con2.Open
MsgBox "接続しました。"

Exit Sub

Err: MsgBox "ボランテア管理システムと接続設定が間違っています。"
  アクセスよりエクセル出力で罫線   myXLS.Range(myXLS.Cells(tt, gg), myXLS.Cells(t, g - 1)).Borders.LineStyle = 1
  アクセスで別ブックのエクセルにデータを出力後、
そのブックを上書きしないで、新ブックにコピーして終了する		  Dim a
Dim b
Dim rst As New ADODB.Recordset
Dim str新ファイル As String
Set rst = New ADODB.Recordset


rst.Open "SELECT * from ＥＸ保存", conn, , , adCmdText
If rst.EOF = True Then Exit Sub

a = rst.Fields("保存先")
b = Format(Now, "yyyymmdd")

str新ファイル = a & "\" & b & "一般支出結果" & ".xlsx"

myWKB.Worksheets("一般支出結果").Copy
myXLS.ActiveWorkbook.SaveAs filename:=str新ファイル
myXLS.ActiveWorkbook.Close
myXLS.ActiveWorkbook.Quit

myXLS.Workbooks.Active
myXLS.ActiveWorkbook.Close SaveChanges:=False
myXLS.Quit

MsgBox "出力しました。"
  メッセイジボックスにデータを入れる  MsgBox " " & rs22.Fields("年月日") & " の同じ日に同じ活動があります"
  クロス集計のクエリー作成時

列表示を固定する方法		  

クエリーのデザイン画面で
  クロス集計の結果を新規テーブルに入力する  SELECT T.* INTO T_cross
FROM [
TRANSFORM Max(個人) AS 個人の最大
SELECT 担当
FROM cross
GROUP BY 担当
PIVOT 時間 In ("1","2","3","4","5","6","7") ]. AS T;


[ ]の中がクエリーです。


外部クエリ-又はＤＡＯで可能　ＡＤＯではエラーとなる
   

UPDATE文でSETする項目を変数にする方法

  

Dim i As Long

Dim x As String

Dim R As Long

Dim S As Long

Dim ss As Long

    R = Me.T_予定.Controls("人数")

     S = Me.T_予定.Controls("追番Ｅ")

         

     Set rs44 = New ADODB.Recordset

           

           rs44.Open "SELECT * FROM 予約作業実施一時 WHERE 確認 = true ", cn, , , adCmdText

            If Not rs44.EOF Then

                For i = rs44.Fields("追番") To S

                

                      Set rs45 = New ADODB.Recordset

              

                      rs45.Open "SELECT * FROM 時刻 WHERE 追番 = " & i & " ", cn, , , adCmdText

                         If Not rs45.EOF Then

                             x = rs45.Fields("時刻").Value

                   

                               With cmd

                               .CommandText = "UPDATE 予約作業実施一時 SET " & x & " = " & R & " WHERE GID = " & rs44.Fields("GID") & ""

                               .CommandType = adCmdText

                               .Execute

                              End With

                          End If

               

                      Next i

                

               End If
   フアンクション側に依頼して、西暦から和暦に変換  Ｐ側

Dim ysa
Dim ysb
Dim ysc

Dim x
' 元データは、2019年6月
ysa = Left(Me.年月, 4)
ysb = Right(Me.年月, 2)
ysc = "01"

aa = DateValue(ysa & "/" & ysb & "/" & ysc)
Call awareki(aa, ab, ac, ad)
x = ab & "年" & ac & "月"

Me.和年月 = x

Ｆ側

Public Function awareki(aa As Variant, ab As Variant, ac As Variant, ad As Variant) As Variant
Dim b
Dim c
Dim d
Dim x
Dim cc
Dim dd
Dim y
Dim yy
' Dim warekitosi
' Dim warekituki
' Dim warekihi
b = aa

Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

Set cn = CurrentProject.Connection

rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.LockType = adLockOptimistic

rs.Open "SELECT * from 元号 order by 始年月日", cn, , , adCmdText
If rs.EOF = True Then
End If
rs.MoveFirst
Do Until rs.EOF
d = rs.Fields("始年月日")
c = rs.Fields("元号")
rs.MoveNext
If rs.EOF Then
yy = c
Exit Do
End If
dd = rs.Fields("始年月日")
cc = rs.Fields("元号")
If b >= d And b < dd Then
yy = c
Exit Do
End If
Loop
x = Year(b) - Year(d) + 1

If x = "1" Then x = "元"

ab = yy & x
ac = Format(b, "mm")
ad = Format(b, "dd")

End Function
   動的配列とRecordCountの例

RecordCountの場合、カーソルの設定が注意
 Dim vA()
Dim k As Long
Dim xz As Long
Dim rz As Long

rs5.CursorType = adOpenStatic
rs5.Open "SELECT * FROM 商品Ｍ ORDER BY 区分,名前", conn, , , adCmdText
If rs5.EOF Then Exit Sub

rz = rs5.RecordCount - 1
ReDim vA(rz, 1)
rs5.MoveFirst
k = 0

Do Until rs5.EOF
vA(k, 0) = rs5.Fields(0)
vA(k, 1) = rs5.Fields(1)

rs5.MoveNext
k = k + 1
Loop

myXLS.Cells(3, 1).Value = "項"
myXLS.Cells(3, 2).Value = "名前"
xz = 4

For k = 0 To rz
myXLS.Cells(xz, 1).Value = vA(k, 0)
myXLS.Cells(xz, 2).Value = vA(k, 1)
xz = xz + 1
Next k
myXLS.Cells(rz + 5, 2).Value = "合計"