Hej.

Jag har en access fråga som med vba kod exporteras till en text fil.

Problemet är att användare kan trycka ett par gånger om de inte ser att den håller på och när den är klar.

Hur skulle man kunna läsa detta med tex en "progress bar" eller liknande

//Torfi

SysCmd acSysCmdInitMeter ,"Exporterar", 100
For I = 1 to 100
    SysCmd acSysCmdUpdateMeter, i
Next
SysCmd acSysCmdRemoveMeter

Hur sätter jag in detta?

Jag har exporten i en funktion som jag anropar med div inparametrar om tex vilken fråga och vilken fil och sökväg m.m.

skall jag ha det i funktionen eller?

<code>

Private Function sExport(strFil As String, strFraga As String)

Dim f As Integer
'If Dir(strFil) <> "" Then
' If MsgBox("Filen finns redan, vill du skriva över den?", vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then Exit Function
'End If
f = FreeFile
Open strFil For Output As f

Dim DBS As Database, RST As Recordset
Set DBS = CurrentDb
Dim a As Field
Dim strExp As String


Set RST = DBS.OpenRecordset(strFraga)
strExp = ""
For Each a In RST.Fields
strExp = strExp & ";" & a.Name
' MsgBox strExp
Next
Print #f, Right(strExp, Len(strExp) - 1)

With RST
While Not .EOF
strExp = ""
For Each a In .Fields
strExp = Trim(strExp) & ";" & Trim(a)
'MsgBox strExp
Next
Print #f, Right(strExp, Len(strExp) - 1)
.MoveNext
Wend
End With
Set RST = Nothing

Close f

MsgBox strFil & " klar!"
End Function

Private Sub Kommandoknapp1_Click()
sExport "c:\Price" & Format(Date, "yymmdd") & Format(Time, "hhmm") & ".txt", "LU253"
End Sub

</code>

Du kan till exempel göra så här:

<code>
Private Function sExport(strFil As String, strFraga As String)

Dim f As Integer
'If Dir(strFil) <> "" Then
' If MsgBox("Filen finns redan, vill du skriva över den?", vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then Exit Function
'End If
f = FreeFile
Open strFil For Output As f

Dim DBS As Database, RST As Recordset
Set DBS = CurrentDb
Dim a As Field
Dim strExp As String
Dim iProgressCounter

Set RST = DBS.OpenRecordset(strFraga)
strExp = ""
For Each a In RST.Fields
strExp = strExp & ";" & a.Name
' MsgBox strExp
Next
Print #f, Right(strExp, Len(strExp) - 1)

iProgressCounter = 1
SysCmd acSysCmdInitMeter, "Exporterar", RST.RecordCount
With RST
While Not .EOF
strExp = ""
For Each a In .Fields
strExp = Trim(strExp) & ";" & Trim(a)
'MsgBox strExp
Next
Print #f, Right(strExp, Len(strExp) - 1)
.MoveNext
SysCmd acSysCmdUpdateMeter, iProgressCounter
iProgressCounter = iProgressCounter + 1
Wend
End With
SysCmd acSysCmdRemoveMeter
Set RST = Nothing

Close f

MsgBox strFil & " klar!"
End Function

</code>

Ok, det fungerade.

Men det är lite anonymt att den håller på att exportera skulle vija ha mer en "mojäng" som snurra likt när man kopierar fil i window, tex...

Fattar ni vad jag menar?

/Torfi

Ett förslag är ju att skapa en animerad ikon i SysTray. Ta en titt här: http://vbnet.mvps.org/code/subclass/shellnotifyanimation.htm
http://vbnet.mvps.org/code/subclass/shellnotifybasic.htm

Eller så kan du skapa din egen GIF-bild och animera den i en dialogruta:
http://vbnet.mvps.org/code/bitmap/loadgif.htm

Du kan använda animation kontroll:
http://support.microsoft.com/?kbid=209919
Jag fick den dock inte att fungera.


Alternativt kan du testa:
http://www.vbaccelerator.com/home/VB/Code/Controls/AVI_Player/ComCtl32_AVI_Player/article.asp