Quiero guardar una imagen bmp, sin que me aparezca el cuadro de dialogo de Guardar Como

Quiero guardar una imagen bmp, sin que me aparezca el cuadro de dialogo de Guardar Como, este es el código con el cual creo la imagen y guardo, pero aquí me aparece el cuadro de dialogo de guardar como, como puedo hacer para que no aparezca y se guarde automáticamente:

Private Sub Command1_Click()
Dim YPos As Single
Dim cc As Integer
For cc = CodCliente To CodClientef
Codigo = ""
Codigo = OXXOId + Format(Negocio, "000") + Format(Suc, "00") + Format(Estado, "00") _
+ Format(Ciudad, "00") + Format(Cuadrante, "000") + Format(Otros, "00000") _
+ Format(CodCliente, "000000") + Format(Fact, "0000") _
+ Format(TipoPago, "0") + Format(FrecPago, "0")
'Asignar Digito Verificador
Codigo = DigitoVerif(Codigo)
' Using Code128C
YPos = GenerateCode128(Codigo, 10, 256, 2)
Guardar.Visible = True
Dim File As OPENFILENAME, sFile As String, sFileTitle As String
Dim FotoPath, FotoFName As String
Dim lResult As Long, iDelim As Integer
Dim CodigoBarras As IPictureDisp
Set CodigoBarras = picBarCode.Image
Dim WSHShell As Object
Set WSHShell = CreateObject("Wscript.Shell")
File.lStructSize = Len(File)
File.hwndOwner = Me.hwnd
ViewDialog = SHVIEW_THUMBNAIL
File.flags = OFN_EXPLORER + OFN_ENABLEHOOK + OFN_ENABLESIZING + OFN_PATHMUSTEXIST
'wildcard to display, returns with selected path\file
If Len(NomFoto) > 0 Then
File.lpstrFile = NomFoto & Space$(254 - Len(NomFoto))
Else
'CAMBIE ESTO!!!!!!
File.lpstrFile = CodCliente & Space$(254 - Len(CodCliente))
End If
File.nMaxFile = 255
'returns with just file name
File.lpstrFileTitle = String$(255, 0)
File.nMaxFileTitle = 255
'set the initial directory, otherwise uses current
If UltFolderFotos = "" Then
File.lpstrInitialDir = ("H:\Documents and Settings\Aux Programacion\Escritorio\Codigo")
Set WSHShell = Nothing
Else
File.lpstrInitialDir = UltFolderFotos
End If
'file type filter
File.lpstrFilter = "Mapa de Bits (*.BMP)" & Chr$(0) & "*.bmp" & Chr$(0) & Chr$(0)
File.nFilterIndex = 1
'dialog title
File.lpstrTitle = "Guardar Imagen"
File.lpfnHook = FARPROC(AddressOf OFNHookProc)
lResult = GetSaveFileName(File)
If lResult <> 0 Then
iDelim = InStr(File.lpstrFile, Chr$(0))
FotoPath = Left$(File.lpstrFile, iDelim - 1)
UltFolderFotos = FotoPath
iDelim = InStr(File.lpstrFileTitle, Chr$(0))
FotoFName = Left$(File.lpstrFileTitle, iDelim - 1)
If UCase(Right(FotoPath, 4)) <> ".BMP" Then FotoPath = FotoPath & ".bmp"
SavePicture CodigoBarras, FotoPath
End If
CodCliente = CodCliente + 1
Next cc
End Sub