- ベストアンサー
アクセス 取り込み時に、桁数（テキスト型）を合わせたい
x0000xの回答
#1です。 回答の補足を頂いていたのに、確認が遅くなりました。 既に解決していた場合には、無視してください。 >クエリ[Q_KMM]にてデータ抽出… >DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Q_KMM", Epath & "\費用.xls", True クエリ"Q_KMM"の抽出時にRight関数で処理できます。 Right("0000" & 列,桁) as 列 意味は、抽出列に前ゼロ文字列を付加し、右から必要な桁数を取得。 Right関数で処理した列には、名前が無いので、元の名前を"As 列"で命名してます。 （１）クエリ"Q_KMM"を選択後、コンテキストメニューから「デザイナー」を選択します。 （２）クエリーデザイナーのテーブル表示ペインでコンテキストメニューの「ＳＱＬビュー」を開きます。 （３）O列(TBL.O列で示します）を以下に変更します。 SELECT ～ ,TBL.O, ～ ↓ SELECT ～ ,Right("00000000000" & TBL.O,11) AS O, ～ （４）Z列も同様に変更します。 SELECT ～ ,TBL.Z, ～ ↓ SELECT ～ ,Right("000" & TBL.Z,3) AS O, ～ （５）クエリ"Q_KMM"を保存します。 ※念のため、クエリ"Q_KMM"のbackupコピーを作成の上、お試しください。 right("000"&T11.c,11) as c, right("0"&T11.d,3)
関連するQ&A
- AccessでSQL結果を直接csvに書き出すには？
Access2003,WinXP お世話になります。 自作のSQLを書いて、結果をTransferTextで手軽にCSVにできないかと考えてこんなのを書いてました。 Dim strSql AS String Dim strPath AS String strSql = 自作SQL文 strPath = c:\test.csv Docmd.TransferText acExportDelim, , strSql, strPath, True しかし、TransferTextでは「テーブル」か「クエリ」名を直接書くように指示してあり、これだと動かない？んでしょうか。 SQLは300個くらい出力する必要があるため（クエリ300個作れば解決するのですが・・・）上のようなコードをループして動かしたいのですが、何か他の簡単な出力方法があるのでしょうか。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- ACCESS VBA でのCSV取込エラー
ACCESS VBA でのCSV取込エラー ACCESSにてフォルダ内にあるCSVファイルをすべてインポートしようとしています。 インポート定義を作成して、下記のコードを書いてみましたが、 データはすべてインポートされるのですが、 カンマが無視され、フィールドとフィールドの中間で途切れてデータが格納されてしまいます。 またフィールド４は日付形式なのですがこれがインポートエラーになります。 フィールド１ フィールド２ フィールド３ フィールド４ aaa aa,bbb bbb,ccc エラー ２日間ほどネットサーフィンをして調べたのですが、 回避方法が見つからなかったので、お知恵を拝借できますでしょうか？ よろしくお願いいたします。 Private Sub cmd06_Click() Dim MyFile As String Dim MyName As String Dim strFolderName As String DoCmd.SetWarnings False DoCmd.OpenQuery "Q09_全CSVデータ削除" DoCmd.SetWarnings True strFolderName = GetFolderName() 'フォルダ選択ダイアログを表示 If Len(strFolderName) > 0 Then '選択結果を評価 MyFile = strFolderName & "\*.csv" '【拡張子csvのファイルのみ取得】 MyName = Dir(MyFile, vbNormal) Do While MyName <> "" If MyName <> "." And MyName <> ".." Then If GetAttr(strFolderName & "\" & MyName) <> vbDirectory Then DoCmd.TransferText acImportFixed, "インポート定義", "T03_全CSVデータ", strFolderName & "\" & MyName, False, "" '【取得したファイルをインポート】 End If End If MyName = Dir Loop Else MsgBox "フォルダは選択されませんでした" End If MsgBox "データのインポートが終了しました" End Sub
- ベストアンサー
- その他MS Office製品
- エクセルVBA 数値の桁数を揃え、つなぎたい
エクセルVBA、初心者です。 以下の記述でつまづいています。 ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★ Dim i As Long 'i は行数を For～Nextで変数にしてます Dim Hbc As Long, Hbc2 As Long 'Hbc は最大11桁の変数 Dim Tsc As Long, Tsc2 As Long 'Tsc は最大5桁の変数 Dim Cd As Long, Cd2 As Long 'Cd は最大4桁の変数 Dim HTC As Long ｜ ｜ 長い為、省略 ｜ ｜ Hbc2 = 100000000000 + Hbc '(1) Tsc2 = 100000 + Tsc Cd2 = 10000 + Cd HTC = Right(Hbc2, 11, 11) & Right(Tsc2, 5, 5) & Right(Cd2, 4, 4) Wks1.Cells(i, 1).Value = HTC ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★ Hbc、Tsc、Cd は、データベースから取得した数値が入りますが、 桁数がバラバラな為、頭に0を表示してそれぞれの最大桁数に揃えたいのです。 桁数を揃えた後、３つをつないで HTC とし、i 行目の１列目に表示しようとしています。 下記がつまづいて、解決できないでいるトコロです。 ＊＊＊＊＊＊＊＊＊＊＊＊問題点＊＊＊＊＊＊＊＊＊＊＊＊ (1)の行の Hbc2 = 100000000000 + Hbc という記述が Hbc2 = 10000000000# + Hbc に置き換わってしまいます。 ＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ なにぶん、初心者で、単純な間違いかもしれませんが、 どうかご指導、宜しくお願いします。
- 締切済み
- Visual Basic
- access一部のフィールドを他のテーブルへVBA
先日 https://okwave.jp/qa/q10245651.html において > table2の新しいデータとして > table1のデータをコピーしたい、 単に追加で ということであれば、という 御回答： Sub Test() Dim StrSQL As String StrSQL = "INSERT INTO table2 SELECT table1.* FROM table1;" DoCmd.SetWarnings False DoCmd.RunSQL StrSQL DoCmd.SetWarnings True End Sub ---------------------- 上記の 回答をいただき うまく稼働しました 部分的にフィールドを別テーブルに 移動するとき ここでは table1のフィールド名 IDに table2のフィールド名 ｂに 入っている数値 にい 1を加えた数値を 移動したいのですが Public Function Test() Dim tb1 As Table Dim tb2 As Table tb1 = table1 tb2 = table2 Dim strSQL As String strSQL = "INSERT INTO table2![ID]SELECT"（"[b]"FROM tablel）+1" （table1のフィールド[b]の数値に1を加えた数値を table2のフィールド[ID]に移行する、というつもりです） DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True End Function 稼働しません すみません 宜しくお願い致します （ついでながら ここで でてくるb というのは テーブル table3 の IDの総和 すなわち SELECT Count(table3.ID) AS b FROM table3; 要は table3の最後のレコードの次のレコードの 番号の数値を table2のIDに移動したい というわけであります） （いずれのIDや ｂについても 数値型 長整数型 重複あり です）
- 締切済み
- Access（アクセス）
- Access csvファイルの取り込み
Access2021 2箇所の保存先の違う所からcsvファイルの取り込みについて伺います。 csv取り込みボタンは、２つ用意しています。 1つ目のボタンに、コード記述して動作確認は正常に動作して他のボタンも正常に動作。 2つ目にのボタンに、csvの格納パス名のみ変更後コード記述して動作確認したら全てのボタンが反応しなくなりました。 動作としては、削除クエリでテーブルのデータを削除してから、指定したフォルダからcsvファイルを選択して取り込ます。 同じテーブルを使用して、格納先の違うcsvファイルを使用する操作になります。 コードは、以下の通りです。 ①ボタン1 Private Sub コマンド61_Click() '削除クエリ実行 DoCmd.SetWarnings False DoCmd.OpenQuery "テーブルデータ削除" DoCmd.SetWarnings True Dim msg As String msg = getFilePicker If msg = "" Then Exit Sub On Error GoTo err_sample DoCmd.TransferText acImportDelim, , "インポート先テーブル名", msg, True MsgBox "インポートが終了しました。", vbInformation + vbOKOnly, "処理完了" Exit Sub err_sample: Select Case Err.Number Case 3011 MsgBox "ファイルが見つかりません。処理を終了します。" Case Else MsgBox Err.Number & ":" & Err.Description End Select End Sub Function getFilePicker(Optional dTitle As String = "ファイル選択") '2003以降 Const msoFileDialogFilePicker As Integer = 3 Dim fDlg As Object Set fDlg = Application.FileDialog(msoFileDialogFilePicker) fDlg.Title = dTitle fDlg.InitialFileName = "csvインポートデータのフォルダパス名①" fDlg.AllowMultiSelect = False fDlg.Filters.Clear fDlg.Filters.Add "すべてのファイル", "*.*" fDlg.Filters.Add "CSV ﾌｧｲﾙ (*.csv)", "*.csv" fDlg.FilterIndex = 1 If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = "" Me.Refresh End Function ②ボタン2 Private Sub コマンド62_Click() '削除クエリ実行 DoCmd.SetWarnings False DoCmd.OpenQuery "テーブルデータ削除" DoCmd.SetWarnings True Dim msg As String msg = getFilePicker If msg = "" Then Exit Sub On Error GoTo err_sample DoCmd.TransferText acImportDelim, , "インポート先テーブル名", msg, True MsgBox "インポートが終了しました。", vbInformation + vbOKOnly, "処理完了" Exit Sub err_sample: Select Case Err.Number Case 3011 MsgBox "ファイルが見つかりません。処理を終了します。" Case Else MsgBox Err.Number & ":" & Err.Description End Select End Sub Function getFilePicker(Optional dTitle As String = "ファイル選択") '2003以降 Const msoFileDialogFilePicker As Integer = 3 Dim fDlg As Object Set fDlg = Application.FileDialog(msoFileDialogFilePicker) fDlg.Title = dTitle fDlg.InitialFileName = "csvインポートデータのフォルダパス名②" fDlg.AllowMultiSelect = False fDlg.Filters.Clear fDlg.Filters.Add "すべてのファイル", "*.*" fDlg.Filters.Add "CSV ﾌｧｲﾙ (*.csv)", "*.csv" fDlg.FilterIndex = 1 If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = "" Me.Refresh End Function ご教授の程、宜しくお願い致します。
- ベストアンサー
- Access（アクセス）
- ACCESS VBA の桁数指定はどこで行う？
VBの桁数指定はどこで行うでしょうか。 Ａテーブルの番号フィールドがテキストタイプで４桁です。 自動採番にしたいのですが、 （略） DIM COUNT AS INTEGER COUNT = COUNT +1 でCOUNTをデバッグで見ると1です。 これを、0001として番号フィールドに書き込む方法がわかりません。 （例）下記のようにしたい。 番号 氏名 0001 山田 0002 田中 0003 高橋 ; VBの初心者なので宜しくお願いします。 そもそも、 DIM COUNT AS INTEGERでCOUNTを４桁など、変数の桁数指定はどこで指定するのでしょうか。
- ベストアンサー
- Visual Basic
- CSV取込みで最終行を取り込まない方法
CSVの取込みで1行目のヘッダーと最終行のフッターを取り込まず 2行目～最終行の前までの中身だけを取り込みたいのですが、 1行目をスキップする方法は、下記を参照にしてなんとかできましたが、 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1230200277 ここに最終行をはぶくという処理をいれるにはどういたらいいでしょうか？ ---------------- Private Sub コマンド0_Click() Dim FSO As Object Dim InFile As Object Dim Outfile As Object Dim CsvPath As String Dim WorkPath As String Dim i As Long Const skipRow = 1 ''1行読み飛ばしの1 ''元のCSVファイルのフルパスに変更して！ CsvPath = "C\JPデータ取込CSV.csv" ''新しく作るCSVファイル。このMDBがあるフォルダにWork.csv 名で作られます。 WorkPath = CurrentProject.Path & "\Work.csv" '' FileSystemObjectのセット Set FSO = CreateObject("scripting.FileSystemObject") Set InFile = FSO.OpenTextFile(CsvPath, 1) Set Outfile = FSO.createTextFile(WorkPath) '' 読み飛ばし設定 For i = i To skipRow InFile.SkipLine Next i ''新しいCSVファイル作成 Outfile.Write InFile.ReadAll ''CSVファイルの終了と解放処理 Outfile.Close InFile.Close Set Outfile = Nothing Set InFile = Nothing ''Work.CSVファイルのインポート（今のDocmd以下をコピーし、ファイル名等を変更！） 'DoCmd.TransferText ・・・・・・ DoCmd.TransferText acImportDelim, "JPご清算書インポート定義", "T01_JPご精算書", WorkPath, True ''使用済みのWork．CSVを削除 FSO.DeleteFile WorkPath ''FileSystemObjectの解放 Set FSO = Nothing MsgBox "取り込み完了" End Sub
- 締切済み
- Visual Basic
- アクセス フィールド名の変更
フィールド名 [1],[2],・・・・を [090701],[090702],・・・ に変更するように Dim i As String Dim ret As String ret = InputBox("入力例 090701") i = ret DoCmd.RunSQL "SELECT [クエリ112].[1] AS [" & i & "], [クエリ112].[2] AS [" & i + 1 & "], ........中略 End Sub としましたが [090701],[90702],[90703],・・・ ２番目から 090702 になりません。 どのようにすればよいのか教えていただけませんか。
- 締切済み
- その他MS Office製品
- データの取り込み
VB6.0 SQLSERVER で開発しています。 EXCELにあるデータをSQLへ取り込みたいのですが 下記のようにすると取り込めるのですが EXCELに空白があるとエラーが出ます。 教えてください。 Dim strSQL As String Dim adoRsWork As ADODB.RecordSet Dim exl As Object Dim i As Integer Dim k As Long Dim mds As Boolean Dim rs As Variant Dim j As Integer Dim s As String Dim ct As Long Dim fno As Integer Dim fnm As String strSel1 = "SELECT" strSel1 = strSel1 & " A.品番" strSel1 = strSel1 & ",A.品名" strSel1 = strSel1 & ",A.倉番" strSel1 = strSel1 & ",A.数量" strFro1 = " FROM " strFro1 = strFro1 & " A_zaiko AS A" strSQL = strSel1 & " " & strFro1 Debug.Print (strSQL) Set adoRsWork = pbAdo.OpenRecordset(strSQL) Set exl = CreateObject("Excel.Sheet") mds = True fnm = "C:\Documents and Settings\デスクトップ\159.xls" j = adoRsWork.Fields.Count - 1 ReDim ctyp(j) As Boolean For i = 0 To j Select Case adoRsWork(i).Type Case 131, 139 ctyp(i) = True Case Else ctyp(i) = False End Select Next adoRsWork.Close Set exl = CreateObject("Excel.Application") exl.Application.Visible = True exl.Application.Workbooks.Open FileName:=fnm k = 1 If mds Then k = 2 End If gSvrADOActiveconnection.BeginTrans On Error Resume Next For k = k To 65536 s = "" If exl.Cells(k, 1) = "" Then Exit For For i = 0 To j If ctyp(i) Then s = s & "," & exl.Cells(k, i + 1) Else s = s & ",'" & exl.Cells(k, i + 1) & "'" End If Next s = Mid(s, 2) strSQL = "insert into " & strFro1 & " values (" & s & ")" pbAdo.OpenRecordset (strSQL) If Err <> 0 Then gSvrADOActiveconnection.RollbackTrans Close fno adoRsWork.Close MsgBox "更新エラー" & Chr(10) & Err & ": " & Error _ & Chr(10) & ct + 1 & " 件目に問題あり" _ & Chr(10) & strSQL End End If ct = ct + 1 Next gSvrADOActiveconnection.CommitTrans On Error GoTo 0 exl.Application.DisplayAlerts = False exl.Application.Quit adoRsWork.Close
- ベストアンサー
- Visual Basic
- データの取り込み
VB6.0 SQLSERVER で開発しています。 EXCELにあるデータをSQLへ取り込みたいのですが 下記のようにすると159.xlsは開くのですがその後FORM付近で正しくない構文があります。とエラーになってしまいます。 何処がおかしいのでしょうか？ 教えてください。 Dim strSQL As String Dim adoRsWork As ADODB.RecordSet Dim exl As Object Dim i As Integer Dim k As Long Dim mds As Boolean Dim rs As Variant Dim j As Integer Dim s As String Dim ct As Long Dim fno As Integer Dim fnm As String strSel1 = "SELECT" strSel1 = strSel1 & " A.品番" strSel1 = strSel1 & ",A.品名" strSel1 = strSel1 & ",A.倉番" strSel1 = strSel1 & ",A.数量" strFro1 = " FROM " strFro1 = strFro1 & " A_zaiko AS A" strSQL = strSel1 & " " & strFro1 Debug.Print (strSQL) Set adoRsWork = pbAdo.OpenRecordset(strSQL) Set exl = CreateObject("Excel.Sheet") mds = True fnm = "C:\Documents and Settings\デスクトップ\159.xls" j = adoRsWork.Fields.Count - 1 ReDim ctyp(j) As Boolean For i = 0 To j Select Case adoRsWork(i).Type Case 131, 139 ctyp(i) = True Case Else ctyp(i) = False End Select Next adoRsWork.Close Set exl = CreateObject("Excel.Application") exl.Application.Visible = True exl.Application.Workbooks.Open FileName:=fnm k = 1 If mds Then k = 2 End If gSvrADOActiveconnection.BeginTrans On Error Resume Next For k = k To 65536 s = "" If exl.Cells(k, 1) = "" Then Exit For For i = 0 To j If ctyp(i) Then s = s & "," & exl.Cells(k, i + 1) Else s = s & ",'" & exl.Cells(k, i + 1) & "'" End If Next s = Mid(s, 2) strSQL = "insert into " & strFro1 & " values (" & s & ")" pbAdo.OpenRecordset (strSQL) If Err <> 0 Then gSvrADOActiveconnection.RollbackTrans Close fno adoRsWork.Close MsgBox "更新エラー" & Chr(10) & Err & ": " & Error _ & Chr(10) & ct + 1 & " 件目に問題あり" _ & Chr(10) & strSQL End End If ct = ct + 1 Next gSvrADOActiveconnection.CommitTrans On Error GoTo 0 exl.Application.DisplayAlerts = False exl.Application.Quit adoRsWork.Close
- ベストアンサー
- Visual Basic