VB6のテキストボックスに入力していると、途中で急に文字が消えてしまうのは何故?

質問

ＶＢ６で、テキストボックスを使ったツールを作ったのですが、起動して文字を入力していると、途中で急に入力した文字が消えてしまいます。
ただ入力を続けているだけなのに、何故でしょう?
文字数とかが関係しているのでしょうか?
そんなに文字数は入れてないんですが・・・。
どなたか教えてください!!　お願いします!!

回答No.8

haporun

このプログラムでは何のイベントなのかわからないのですが、カレンダーの日付クリックイベントなのでしょうか。
Private Sub ～～～()から書いてほしかったです。

このイベントが、タイマーやキーイベントなどのリアルタイムなイベントでない限り、テキストボックスに文字を入力中に文字が勝手に消えてしまうということはありえません。
やはりPrivate Sub ～～～()の部分がわからないことにはどうにも・・・。
あと、貼り付けているコントロールやそのコントロールで発生するイベントなどを補足してくだされば、おそらく解決の糸口は見つかるかと思います。

このようにどの時点で不具合が起こっているかわからないようなときは、それを起しうるイベントが特定できなければ、解決のしようがありません。
いろんなところに

If Text1.Text = "" Then Stop

を書いておくのも手です。
こうすれば、テキストが空になった時点でコードが中断し、場所を特定できます。

ちなみに、プログラム上のアドバイスを。

App.Pathは通常 "C:\Temp" などの、最後に "\" を含んでいない文字を保持していますが、プログラムがルートにある場合は "C:\" などと最後に "\" が含まれています。
このため、App.Path + filename とすると、\がダブってしまう可能性もあるということです。
プログラムの腕が上達してきて、配布などを考えることがあれば、この点は無視できません。

また、同じフォーム上のコントロールを指定するのに、Form1.Text1 のように Form1 と指定するのはオススメできません。

補足

ありがとうございます。ツールの内容は以下のとおりです。
Option Explicit
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal naiyou As String, ByVal lpFileName As String) As Long
Private Sub clear_Click()
Form1.Label1.Caption = ""
Form1.Label2.Caption = ""
Form1.Text1.Text = ""
End Sub
Private Sub Command1_Click()
Dim out2 As String
Dim day As String
Dim filename As String
Dim henkan As String
Dim henkan2 As String
Dim ans As String
If Label1.Caption = "" Then
MsgBox "****************** ", vbCritical
Exit Sub
Else
If Text1.Text = "" Then
ans = MsgBox("******************", vbYesNo + vbQuestion
If ans = vbNo Then
Exit Sub
End If
End If
End If
henkan = Form1.Label1.Caption
henkan2 = Replace(henkan, "/", "")
filename = "\" & henkan2 & ".txt"
If Dir(App.Path & filename) = "" Then
out2 = Text1.Text
Open App.Path & filename For Output As #1
Print #1, out2
Close #1
Else
ans = MsgBox("******************", vbYesNo + vbQuestion
If ans = vbNo Then
Exit Sub
Else
Kill Dir(App.Path & filename)
out2 = Text1.Text
Open App.Path & filename For Output As #1
Print #1, out2
Close #1
End If
End If
End Sub
Private Sub copy_Click()
Clipboard.SetText Form1.Text1.SelText
End Sub
Private Sub cut_Click()
Clipboard.SetText Form1.Text1.SelText
Form1.Text1.SelText = ""
End Sub

Private Sub keep_Click()
Call Command1_Click
End Sub

Private Sub logon_Click()
optionman.Show
End Sub

Private Sub paste_Click()
Form1.Text1.SelText = Clipboard.GetText
End Sub
Private Sub fin_Click()
Unload Me
Unload myplan
End Sub
Private Sub monthview1_selchange(ByVal startdate As Date, _
ByVal enddate As Date, Cancel As Boolean)
Form1.Label1.Caption = startdate
If Weekday(startdate) = 1 Then
Form1.Label2.Caption = "日"
Form1.Label2.ForeColor = vbRed
Form1.Label1.ForeColor = vbRed
End If
If Weekday(startdate) = 2 Then
Form1.Label2.Caption = "月"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 3 Then
Form1.Label2.Caption = "火"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 4 Then
Form1.Label2.Caption = "水"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 5 Then
Form1.Label2.Caption = "木"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 6 Then
Form1.Label2.Caption = "金"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 7 Then
Form1.Label2.Caption = "土"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Format(startdate, "mm/dd") = "01/01" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "02/11" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "04/29" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "05/03" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "05/04" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "05/05" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "07/20" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "09/15" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "11/03" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "12/23" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "01/02" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "01/03" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
Dim day As String
Dim filename As String
Dim henkan As String
Dim henkan2 As String
Dim readdata As String
Dim readend As String
Dim filename2 As String
henkan = Form1.Label1.Caption
henkan2 = Replace(henkan, "/", "")
filename = "\" & henkan2 & ".txt"
filename2 = "\" & henkan2 & ".dat"
If Dir(App.Path & filename) = "" Then
Form1.Text1.Text = ""
Else
Open App.Path & "\" & filename For Input As #1
Do Until EOF(1)
Line Input #1, day
readdata = readdata & day & vbCrLf
Loop
readend = Replace(readdata, "", "")
Close #1
Form1.Text1.Text = readend
End If
End Sub
Private Sub plan_Click()
myplan.Show
If Form1.Label1.Caption = "" Then
MsgBox "******************", vbExclamation
Unload myplan
Else
myplan.Label1.Caption = "20" & Form1.Label1.Caption & " (" & Form1.Label2.Caption & ")"
End If
End Sub

Private Sub Timer1_Timer()
Dim filename As String
Dim henkan As String
Dim henkan2 As String
Dim filename2 As String
henkan = Form1.Label1.Caption
henkan2 = Replace(henkan, "/", "")
filename2 = "\" & henkan2 & ".dat"
If App.Path & filename2 = "" Then
Form1.Label6.Caption = ""
Else
Dim strFileName As String
Dim strSectionName As String
Dim strKeyName As String
Dim strValue As String * 1024
Dim lngStrLength As Long
Dim lngResult As Long
strFileName = App.Path & filename2
strSectionName = "nikki"
strKeyName = "plantext"
lngStrLength = Len(strValue)
lngResult = _
GetPrivateProfileString( _
strSectionName, _
strKeyName, _
"", _
strValue, _
lngStrLength, _
strFileName)
Form1.Label6.Caption = _
Left(strValue, _
InStr(strValue, _
vbNullChar) - 1)
End If
Form1.Label6.Left = Form1.Label6.Left - 50
If Form1.Label6.Left + Form1.Label6.Width < 0 Then
Form1.Label6.Left = Form1.Label6.Width
End If
End Sub

Private Sub version2_Click()
Version.Show
End Sub
カレンダーの日付をクリックして、ラベルに日付を表示→テキストの内容を書いて、最後に「保存」専用ボタンを押す→yymmdd.txtに内容をセーブする→保存した日付をクリックすると、その日付のyymmdd.txtを読み込んでテキストボックスに表示する　というものです。
あと、予定登録に文字を入れると、ファイルにセーブして、画面下のラベルを文字が流れて表示されるというのもあります。
こんなんでお分かりいただけるでしょうか。見当違いだったらごめんなさい！！！