- ベストアンサー
データの取り込み: VB6.0 SQLSERVER
- VB6.0 SQLSERVERでデータの取り込みを行いたいが、エラーが発生している。
- 取り込み処理を行うVB6.0プログラムで、EXCELのデータをSQLに取り込む際にエラーが発生しています。
- VB6.0 SQLSERVERでデータの取り込みを行う際に、159.xlsを開いた後に構文のエラーが発生しています。
- aki08102001
- お礼率15% (25/159)
- Visual Basic
- 回答数2
- ありがとう数3
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- utugi_taro
- ベストアンサー率73% (19/26)
strSQL = "insert into " & strFro1 & " values (" & s & ")" たぶんここですね。 これではINSERT文が insert into FROM A_zaiko AS A values ( ... に、なってしまいます。 INSERT文の構文エラーです。
補足
済みません。 どう直せばいいのでしょうか？
関連するQ&A
- データの取り込み
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
- EXCELへのデータ出力
VB6.0で開発しています。 下記のようにEXCELへのデータ出力は出来たのですが EXCELのシートのA列とB列は文字列にしたいのです。 今はA列とB列に数字を入れると右詰になってしまいます。 どうすればいいでしょうか？ 教えてください。 Dim s3cn_ado As variant Dim dsn As String Dim tbl As String Dim tky As String Dim sql As String Dim rs As variant Dim fnm As String Dim mds As boolean Dim fno As Integer Dim i As Integer Dim j As Integer Dim k As long Dim s As String Dim ct As long Dim exl As Object dsn = "dsn=SAK3_ADO;uid=SAK;pwd=SAK" tbl = "sak.受注m" tky = "受注番号 = ''" '0 件のダミー問い合わせ用のキー" fnm = "g:\tmp\test.xls" mds = true set s3cn_ado = CreateObject ("ADODB.Connection") s3cn_ado.Open dsn sql = "select * from " & tbl & " where " & tky set rs = s3cn_ado.Execute(sql) j = rs.fields.count - 1 redim ctyp(j) as boolean For i = 0 to j select case rs(i).type case 131, 139 ctyp(i) = true case else ctyp(i) = false end select Next rs.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 s3cn_ado.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) sql = "insert into " & tbl & " values (" & s & ")" s3cn_ado.Execute sql if err <> 0 then s3cn_ado.RollbackTrans close fno s3cn_ado.Close msgbox "更新エラー" & chr(10) & err & ": " & error _ & chr(10) & ct + 1 & " 件目に問題あり" _ & chr(10) & sql end end if ct = ct + 1 next s3cn_ado.CommitTrans on error goto 0 exl.Application.DisplayAlerts = False exl.Application.Quit s3cn_ado.Close
- ベストアンサー
- Visual Basic
- ExcelのVBAソースコード（一部）の翻訳
ソースコードの一部ですが、開発者が他界し訊けずにおります。 今後自分でもVBAを勉強しますが、お教えいただけますでしょうか。 なお冒頭は Function process_new(m0 As Integer, m As Integer, d As Variant, ans As Double) As Integer Dim a(501), b(501), s(501), r(501) As Double Dim w(501), g(11), xx As Double Dim s1 As Double Dim k(501) As Integer Dim i, j, flg As Integer でスタートしています。 ＝（以下、質問内容）＝＝＝＝ s1 = s(k(0)) * 1.618 flg = 0 For i = m0 To m - 3 If Not i = k(0) Then If s1 > s(i) Then flg = flg + 1 End If End If Next i ＝（以上）＝＝＝＝
- 締切済み
- オフィス系ソフト
- VBAでの質問
お世話になります。 下記の記述で、「←」の矢印の記述で、 Cells.（５，２）がブランクでなければ、 「→」から進めたいのですが、 どの様に記述すれば宜しいでしょうか ご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3) ← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub
- ベストアンサー
- Visual Basic
- 配列のセットの仕方
度々質問してすいません。 英文の単語を抽出して頻度順に並べるプログラムをＶＢで作りたいと思っております。下記ＵＲＬのＶＢ版です。 （http://gamp.c.u-tokyo.ac.jp/archive/perl.htm） 以下が作成したソースです。これとQuickSortのソース（http://www.geocities.co.jp/SilkRoad/4511/vb/sort.htm） を繋げて終わりたいと思うのですが、 どうつなげたらいいのかわかりません。 アドバイスをお願いいたします。 Private Sub Command1_Click() Dim strTarget As String Dim strResult As String Dim cha As String Dim chaList() As String Dim word As String Dim wordList() As Long Dim i As Long, j As Long Dim EndFlg As String strTarget = Me.Text1.Text i = 0 EndFlg = "" Do Until EndFlg = "END" i = i + 1 cha = Mid(strTarget, i, 1) If cha <> "" Then ReDim Preserve chaList(i) chaList(i - 1) = cha Else EndFlg = "END" End If Loop For i = 0 To UBound(chaList) - 1 If chaList(i) = "." Then chaList(i) = " " End If Next Text2 = "" For i = 0 To UBound(chaList) - 1 Text2 = Text2 & chaList(i) Next Text3 = "" word = "" For i = 0 To UBound(chaList) - 1 If chaList(i) = " " Then If i = 0 Then Else If chaList(i - 1) = " " Then Else Text3 = Text3 & Chr(13) & Chr(10) & word word = "" End If End If Else word = word & chaList(i) End If Next If word <> "" Then Text3 = Text3 & Chr(13) & Chr(10) & word End If
- ベストアンサー
- Visual Basic
- エクセルでのアクセスからのデータ抽出
Web情報を参考にエクセルにて下記VBAコードを作りました。 Sub DB_Read() Dim adoCON As New ADODB.Connection Dim adoRS As New ADODB.Recordset Dim strSQL As String Dim odbdDB As Variant Dim wSheetName As Variant Dim i, j As Integer Dim GetName odbdDB = ActiveWorkbook.Path & "\test.accdb" adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" _ & "Data Source=" & odbdDB & "" adoCON.Open j = 4 Do Until j = 18 GetName = Range("B4").Value & "_" & Cells(16, j).Value strSQL = "SELECT 規格値,Max,Min,結果1,結果2,結果3 FROM T_測定結果 WHERE [測定項目]='" & GetName & "'" adoRS.Open strSQL, adoCON, adOpenDynamic wSheetName = ActiveSheet.Name i = 20 adoRS.MoveLast Do Until adoRS.EOF Or i = 25 With Worksheets(wSheetName) .Cells(17, j).Value = adoRS!規格値 .Cells(18, j).Value = adoRS!Max .Cells(19, j).Value = adoRS!Min .Cells(i, j).Value = adoRS!結果1 .Cells(i + 10, j).Value = adoRS!結果2 .Cells(i + 20, j).Value = adoRS!結果3 End With i = i + 1 adoRS.MovePrevious Loop j = j + 1 Loop adoRS.Close Set adoRS = Nothing adoCON.Close Set adoCON = Nothing End Sub VBAを走らせると1巡は走るのですが、「Do Until j = 18」の2巡目に入ると、「wSheetName = ActiveSheet.Name」のところで「実行時エラー3705 アプリケーション定義またはオブジェクトの定義エラー」と出てしまいます。 エラーの原因が分からないので、アドバイスを頂きたいです。
- ベストアンサー
- Excel（エクセル）
- ＶＢ６でＥＸＣＥＬをクローズ出来ない
ＶＢ６でＥＸＣＥＬを使用した後クローズ処理をしたつもりですが、ＶＢと別にＥＸＣＥＬを起動しＶＢで使ったＥＸＣＥＬを読み込もうとすると、「編集のためロックされています」とメッセージが出て、読み取り専用でしかオープン出来ません。また、ＶＢでＥＸＣＥＬを繰り返しオープンするとメモリがいっぱいになってしまいます。 ＶＢでのＥＸＣＥＬオープンは Dim fnm As String Dim exl As Object fnm = "EXCEL File名" 'フルパスで指定 Set exl = CreateObject("Excel.Application") exl.Application.Workbooks.Open FileName:=fnm クローズは Set exl = CreateObject("Excel.Application") exl.Application.Quit Set Sheet = Nothing Set BooK = Nothing Set ExcelApp = Nothing 以上です。なお、ＶＢの参考書は入門書だけ持っていますが、このようなことは書いてありません。従って上のコードも意味もわからず、ネットから拾ってきたまま使用しています。参考書または、Ｗｅｂサイトを紹介して頂ければ有り難いです。
- 締切済み
- その他(ソフトウェア)
- 変数に入った値を追加したい
Access97を使用しています。SQLで変数に入った値を追加したいのです。 Dim strSQL, NO3, NO2 As String Dim i As Integer Dim db As DATABASE Dim SN As Variant If (C_Flag = 0) Then SN = 0 Else SN = 1 End If strSQL = "INSERT INTO 連続印刷 (Nフラグ" strSQL = strSQL & ") VALUES (" strSQL = strSQL & "', 'SN'" strSQL = strSQL & ")" Set db = CurrentDb() db.Execute strSQL Set db = Nothing End Sub 上記のようにすると、"SN"のデータが入ります。 'SN'をSNのようにすると、パラメータが少なすぎますと出てきます。 どうすれば、上記 0や1の値を取得することができるのでしょうか？
- ベストアンサー
- オフィス系ソフト
- VBAで、ExcelシートにCSVファイルのデータを取り込みたいのです
VBAで、ExcelシートにCSVファイルのデータを取り込みたいのですが、 1行目しか取り込めません。 取り込む項目数は32個です。 以下のコードでは、Excelシートの1行目のみ取り込みができますが、 1行目32列目のセルには、2行目のA列に表示されるべきデータも表示されます。 2行目以下は取り込みできていません。 Sub CSV取込() Dim OpenFileName As String Dim MyString As String Dim MyVar As Variant Dim i As Long, j As Long OpenFileName = Application.GetOpenFilename("CSVファイル,*.csv") If OpenFileName = "False" Then MsgBox "キャンセルされました。" Else Open OpenFileName For Input Access Read As #1 i = 1 While Not EOF(1) Line Input #1, MyString MyVar = Split(MyString, ",") If MyVar(0) <> "" Then For j = 0 To 31 ThisWorkbook.ActiveSheet.Cells(i + 10, j + 1) = MyVar(j) Next j i = i + 1 End If Wend Close #1 End If End Sub おそらく、改行が判別できないためかと思いますが、 どこが間違っているのかがわかりません。 アドバイスをよろしくお願いします。
- ベストアンサー
- その他MS Office製品
- データ検索ネスト Excel VBA
excel2003でデータ検索の処理をするというマクロをVBAで作成したいのですが、うまく動作しません。自作のVBAを記載してみましたので何が原因なのか教えてください。初心者です、よろしくお願いします。 Sub データ検索() Dim i As Integer, j As Integer, k As Integer, l As Integer Dim myRange As Range Dim IngLastrow As Long IngLastrow = Range("A65536").End(xlUp).Row For i = 3 To IngLastrow For j = 3 To 25 For k = 8 To 53 For l = 3 To 9 Set myRange = Worksheets("データベース").Cells(i, "o").Find(what:=Worksheets("コード").Cells(j, "o").Value, _ LookIn:=xlValues) If Not myRange Is Nothing Then Worksheets("予定").Cells(k, l).Value = myRange.Offset(, -12).Value End If Next l Next k Next j Next i End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます。 うまく出来ました。 またわからないところがあったらお願いします。