coding help

[Tailgun]

here is the code the ??????'s indicate where I need to put some additional code to make the sub continue finishing the second part. If I put Next it wants a For but not sure just what to do here any help would be really great
Thanks

Private Sub SSTab1_GotFocus()
On Error Resume Next
Dim objConn1

Dim i As Integer
i = 0
Set objConn1 = New ADODB.Connection
objConn1.ConnectionString = "DSN=eDoan;UID=sa"
objConn1.Open
Dim objRS1
Set objRS1 = objConn1.Execute("Select * from tblImages Where ClaimID = '" & frmImages.txtClaimNumber.Text & "'&quot
Dim MyPic As String
Dim MyPic2 As String
Do While objRS1.EOF <> True
MyPic = UCase(objRS1(&quot;Description&quot)
If MyPic Like &quot;*JPG&quot; Or MyPic Like &quot;*BMP&quot; Or MyPic Like &quot;*GIF&quot; Then
Image1(i).Picture = LoadPicture(objRS1(&quot;Description&quot)
Image1(i).Tag = objRS1(&quot;ID&quot
Check1(i).Value = objRS1(&quot;Checked&quot
Check2(i).Value = objRS1(&quot;CheckedS1&quot
Check3(i).Value = objRS1(&quot;CheckedS2&quot
i = i + 1
End If
objRS1.MoveNext

Loop

???????????????????????????????????????????

Do While objRS1.EOF <> True

MyPic2 = UCase(objRS1(&quot;Description&quot)
If MyPic2 Like &quot;*TIF&quot; Or MyPic Like &quot;*DOC&quot; Or MyPic Like &quot;*TXT&quot; Or MyPic Like &quot;*PDF&quot; Then
Label18(i).Caption = (objRS1(&quot;Description&quot)
Label18(i).Tag = objRS1(&quot;ID&quot
Check7(i).Value = objRS1(&quot;Checked&quot
Check8(i).Value = objRS1(&quot;CheckedS1&quot
Check9(i).Value = objRS1(&quot;CheckedS2&quot

i = i + 1
End If
objRS1.MoveNext

Loop

Set objRS1 = Nothing
objConn1.Close
Set objConn1 = Nothing



End Sub

 

[hirick]

if not objRS1.BOF then
objRS1.MoveFirst
End if

...................................
Alternatively, you could do both tasks while moving through the recordset once:

Dim iDoc as Integer, iPic as integer

Do While objRS1.EOF <> True
MyPic = UCase(objRS1(&quot;Description&quot)
If MyPic Like &quot;*JPG&quot; Or MyPic Like &quot;*BMP&quot; Or MyPic Like &quot;*GIF&quot; Then
Image1(iPic).Picture = LoadPicture(objRS1(&quot;Description&quot)
Image1(iPic).Tag = objRS1(&quot;ID&quot
Check1(iPic).Value = objRS1(&quot;Checked&quot
Check2(iPic).Value = objRS1(&quot;CheckedS1&quot
Check3(iPic).Value = objRS1(&quot;CheckedS2&quot
iPic = iPic + 1

elseIf MyPic2 Like &quot;*TIF&quot; Or MyPic Like &quot;*DOC&quot; Or MyPic Like &quot;*TXT&quot; Or MyPic Like &quot;*PDF&quot; Then
Label18(iDoc).Caption = (objRS1(&quot;Description&quot)
Label18(iDoc).Tag = objRS1(&quot;ID&quot
Check7(iDoc).Value = objRS1(&quot;Checked&quot
Check8(iDoc).Value = objRS1(&quot;CheckedS1&quot
Check9(iDoc).Value = objRS1(&quot;CheckedS2&quot
iDoc = iDoc + 1
End If
objRS1.MoveNext

Loop

 

[Tailgun]

hirick,

I used your code and made some progress. The problem now is it doesn't find all the items in the second search. It finds all the images from the first but the second elseif it doesn't show all the items. Any thoughts ?

 

[kevinclark]

Check the variable names
hirick's code looks good other than it has

Elseif MyPic2 ?

Should be MyPic I think ??

 

[Tailgun]

kevin,
I changed it to Elseif MyPic and it seems to work fine now
since MyPic1 or MyPic2 doesn't exsist it worked fine sayin Elseif MyPic etc

 

[hirick]

Good catch Kevin.

 

[Tailgun]

kevin,

Not sure you will remember but here is the code

Private Sub Command4_Click()
On Error GoTo ErrorHandler
Dim ErrPrmpt As Long
Dim objConn3
Set objConn3 = New ADODB.Connection
objConn3.ConnectionString = &quot;DSN=eDoan;UID=sa&quot;
objConn3.Open
Dim i As Integer
'Need to 1st set Reference to Microsoft Scripting Runtime
Dim fso As New FileSystemObject
Dim fil As File
Dim strDestination As String
Dim SQL As String
strDestination = &quot;C:\Doanimageback\&quot;
For i = 0 To Image1.Count - 1
SQL = &quot;Select Description &quot;
SQL = SQL & &quot;from tblImages &quot;
SQL = SQL & &quot;Where ID = &quot; & Image1(i).Tag
Set objRS3 = objConn3.Execute(SQL)
'Check for NULLS and &quot;&quot; values
If (objRS3(&quot;Description&quot & &quot;&quot <> &quot;&quot; Then
Set fil = fso.GetFile(objRS3(&quot;Description&quot)
'Set True to overwrite any pre-existing files
fil.Copy strDestination, True
End If
Next i
objRS3.Close
Set objRS3 = Nothing
objConn3.Close
Set objConn3 = Nothing
iReturnValue = MsgBox(&quot;Export Complete&quot;, vbOKOnly)
Exit Sub
ErrorHandler:
Select Case Err.Number
Case Is = 440
Resume Next
Case Else
ErrPrmpt = MsgBox(&quot;Encountered Err# &quot; & Err.Number _
& &quot; Described as &quot; & Err.Description & Chr$(13) _
& &quot;Continue ?&quot;, vbCritical + vbYesNo, &quot;Error&quot
If ErrPrmpt = vbYes Then
Resume Next
Else
Exit Sub
End If
End Select
End Sub
-----
it works just fine but I also have to incorporate a Label1(i) to copy the other stuff into the folder Label1 is also an array.


The other question is you see it copies the files into a set directory. Is there anyway to have the code create a directory name based on a txtbox.text (ClaimNumber)that way the user will have a folder created based on a specific file number so if he opens another record it will create another directory based on THAT filenumber ?

 

[hirick]

To create the folder, use the FileSystemObject GetFolder and CreateFolder methods.

dim strPath as string
const strDrive=&quot;c:\&quot;

strPath= strDrive & txtClaim.text
Set fso = CreateObject(&quot;Scripting.FileSystemObject&quot
Set f = fso.CreateFolder(strPath)

...

ErrorHandler:
Select Case err.number
...
Case 58 'folder already exists
set f = fso.GetFolder(strPath)
resume next
...

 

[Tailgun]

thanks hirick that should do the trick

 

[kevinclark]

Thanks hirick but I only caught it because I am notorious for typo's so I have formed a habit of checking for them first.


The Label array is based on the same &quot;Description&quot; field so that is being handled OK for you now ?