2012-03-07 28 views
6

Tengo alrededor de 10k imágenes y necesito subirlas al almacenamiento de blobs. ¿Hay alguna herramienta que haga una carga masiva? También estoy abierto a escribir mi propia aplicación.Carga masiva a blob en Azure

Respuesta

2

Mire ClumsyLeaf cloud explorer. Vamos a subir archivos a blob como un cliente FTP. Alternativamente Azure Storage Explorer. La misma idea.

Ambos le permiten seleccionar archivos de un directorio y cargarlos de una vez. Nunca lo intenté con 10000, pero debería funcionar.

+0

any mac client? –

+0

Lo sentimos, no es un usuario de Mac. http://stackoverflow.com/questions/19553587/any-azure-storage-viewer-available-for-mac – GraemeMiller

+1

Microsoft lanzó una vista previa de su propio Storage Explorer para Windows, Linux y OS X: https://github.com/Azure/deco – Tom

1

Puede usar Windows Azure PowerShell para cargar/descargar varios archivos del almacenamiento de azure.

Para cargar varios archivos, puede usar la siguiente línea de comando.

ls -File -Recurse | Set-AzureStorageBlobContent -Container upload 

Para la descarga de varias notas, puede utilizar la siguiente línea de comandos.

Get-AzureStorageBlob -Container containername -Blob blobname | Get-AzureStorageBlobContent 

Para obtener más información, consulte la página MSDN.

http://msdn.microsoft.com/en-us/library/dn408487.aspx

http://msdn.microsoft.com/en-us/library/dn408562.aspx

1

He descubierto que las herramientas existentes son o bien PAYware o lento debido al uso de unos hilos. TBH incluso las aplicaciones de pago que he probado eran bastante lento, pero la API Azure es muy fácil, así que terminé de escribir mi propia herramienta de línea de comandos, se llama azupload:

https://github.com/bviktor/azupload

Es gratuita, publicada bajo el Licencia de MIT Tiene una versión C# y una Java para que pueda implementarla fácilmente tanto en Windows como en Linux.

La versión C# utiliza el programador .NET interno para iniciar nuevos subprocesos (generalmente es 10-ish en mi comp), mientras que la versión Java inicia tantos subprocesos como usted especifique. Es bastante eficiente, lo he probado con 700 imágenes (tamaño total de 20MiB) y 100 hilos, terminó de cargarlos en 8 segundos.

Por supuesto, tienes que encontrar un equilibrio. Si inicia demasiados subprocesos, eventualmente se ralentizará debido a la sobrecarga de la máquina virtual de Java. Además, si carga archivos grandes, tiene poco sentido cargarlos en 100 subprocesos porque en este caso el cuello de botella será el ancho de banda, no la sobrecarga transaccional como con muchos archivos pequeños. Además, si carga muchos archivos, la JVM abrirá los archivos más rápido de lo que podría cerrarlos, por lo que después de un tiempo obtendrá Too many open files excepciones (para mí eso sucedió con 13k archivos @ 100 hilos). Así que como regla general, cuanto más pequeños sean los archivos, más hilos, pero probablemente deba detenerse en algún lugar alrededor de 50.

¡Se agradece mucho la opinión!

+0

omg. gracias. este ha sido un gran PITA. agregando una opción de descarga también y con suerte le enviaremos una solicitud de extracción pronto. – viggity

0

1.Option Explicit:

enumeraciones ======== para elegir el formato en el que desea pegar ===== Enum eFormat

Picture = 1 Chart = 2 Table = 3 
End Enum 

========= =============================================== ============

 Sub pGeneratePPT_Click() 
     Dim lngWksCount   As Long Dim lngLoopFirst  As Long Dim lngLoopSecond  As Long Dim lngSlide   
As Long Dim objTemplate   As Object 
     If MsgBox("Please click OK to generate the slide or click CANCEL to exit from the existing process.", vbOKCancel, "WARNING!") 
= vbCancel Then 
     MsgBox "You have selected CANCEL please click the 'PPT converter' button again to convert into power point.", 
vbInformation, "Generation of slide presentation has been 
cancelled." 
     GoTo lblExit End If 
     lngWksCount = ThisWorkbook.Worksheets.Count Set objTemplate = Wks_INDEX.OLEObjects("objPPTTemplate") 
     For lngLoopFirst = 1 To lngWksCount 
     With ThisWorkbook.Worksheets(lngLoopFirst) 
      For lngLoopSecond = 1 To .ChartObjects.Count 
       If .ChartObjects(lngLoopSecond).Visible = True Then 
        lngSlide = lngSlide + 1 
        Call fPPTGenerator(objTemplate, .Name, lngSlide, Chart, .ChartObjects(lngLoopSecond).Name) 
       End If 
      Next lngLoopSecond 
     End With Next lngLoopFirst 
     MsgBox "Done!", vbInformation 
    lblExit: lngWksCount = Empty lngLoopFirst = Empty lngLoopSecond = Empty lngSlide = Empty Set objTemplate = 
Nothing 
     End Sub 


     Function fPPTGenerator(objOLEObject As Object, strSheetName As String, lngSlide As Long, enumPasteAs As eFormat, _ 
        strRangeOrChartName As String, Optional dblLeftInInches As Double, Optional dblTopInInches As Double, _ 
        Optional dblHeightInInches As Double, Optional dblWidthInInches As Double) 
     Dim lngLoopFirst   As Long Dim lngLoopSecond   As Long Dim objSlide    As Object 'PowerPoint.Slide 
Dim objTemplate    As Object 'Embbed File for template 
Dim objLayout    As Object Dim objMainObject   
As Object Dim varPicture    As Variant Dim lngStatus 
As Long Dim objShape    As Object Dim 
strPathTemplate   As String Dim objFileSystem   As 
Object Dim objFile     As Object Dim strFileName 
As String Dim objPresTemp    As Object Dim blnOpen 
As Boolean Dim objPPT     As Object Dim objPres 
As Object Dim blnNoError    As Boolean Dim 
blnTemplateNotFound  As Boolean 
     lngStatus = Application.ScreenUpdating Application.ScreenUpdating = False 

      On Error GoTo lblNewPPT '****If the presentation is already open or not**** Set objPPT = GetObject(, 
"Powerpoint.Application") Set objPres = objPPT.presentations(1) 
blnOpen = True '************************************************** 
     lblNewPPT: '****If the presentation is not opened already**** If blnOpen = False Then On Error GoTo 0: On Error GoTo -1: 
Err.Clear 
     Set objPPT = CreateObject("Powerpoint.Application") 
     Set objPres = objPPT.presentations.Add End If '************************************************** Set 
objFileSystem = CreateObject("Scripting.FileSystemObject") 
    '**********Setting or adding the slides*********** If objPres.slides.Count <> lngSlide Then 
     Set objLayout = objPres.Designs(1).SlideMaster.CustomLayouts(1) 
     Set objSlide = objPres.slides.Addslide(lngSlide, objLayout) Else 
     Set objSlide = objPres.slides(lngSlide) End If '************************************************** 
     '*******Opening the embbed file in the editing mode********* objOLEObject.Verb Verb:=xlEditBox objPPT.WindowState = 2 
'************************************************** 
     '*****Open the presentation and saving it at the workbook path***** Set objPresTemp = objPPT.activepresentation 
objPresTemp.SaveAs ThisWorkbook.Path & "\Template.pot" 
objPresTemp.Close 
'************************************************** 
objPPT.WindowState = 2 For Each objFile In 
objFileSystem.getfolder(ThisWorkbook.Path).Files 
     If Right(objFile.Name, 3) = "pot" Then 
      strFileName = objFile.Name 
      blnTemplateNotFound = False 
      Exit For 
     Else 
      blnTemplateNotFound = True 
     End If Next 
     If blnTemplateNotFound = False Then 
     objPres.ApplyTemplate FileName:=ThisWorkbook.Path & "\Template.pot"  'Applying the Template to the new presentation 
Else 
     MsgBox "Please embed the template in the" & vbNewLine & "'Microsoft Powerpoint 93-2003 Template' (*.pot) Format!", 
vbCritical 
     blnNoError = False 
     GoTo lblExit: End If 
     Kill ThisWorkbook.Path & "\" & strFileName        'Deleting the template thereafter applying 
     For lngLoopFirst = 1 To objSlide.Shapes.Count       'Removing the extra shapes on the new slide 
     objSlide.Shapes(lngLoopFirst).Delete 
     If objSlide.Shapes.Count > 0 Then 
      lngLoopFirst = lngLoopFirst - 1 
     Else 
      Exit For 
     End If Next 
     objPPT.Visible = True Select Case enumPasteAs 

     Case Picture: 
      On Error GoTo lblErrorPic 
      Set objMainObject = ThisWorkbook.Worksheets(strSheetName).Shapes(strRangeOrChartName) 

      objMainObject.CopyPicture Format:=xlPicture 
      Set varPicture = objSlide.Shapes.PasteSpecial(2) 
      varPicture.LockAspectRatio = False 
      blnNoError = True lblErrorPic: 
      If blnNoError = False Then 
       MsgBox "Shape object not Found!" & vbNewLine & vbNewLine & "Worksheet: " & strSheetName & _ 
       vbNewLine & "Shape:   " & strRangeOrChartName, vbCritical 
       On Error GoTo 0: On Error GoTo -1: Err.Clear 
       GoTo lblExit 
      End If 

     Case Chart: 
      On Error GoTo lblErrorChart 
      Set objMainObject = ThisWorkbook.Worksheets(strSheetName).Shapes(strRangeOrChartName) 

      objMainObject.Copy 
      objPPT.Activate 
      objSlide.Select 
      objPPT.ActiveWindow.View.Paste 
      Set varPicture = objSlide.Shapes(1) 
      blnNoError = True 
      lblErrorChart: 
      If blnNoError = False Then 
       MsgBox "Chart not Found!" & vbNewLine & vbNewLine & "Worksheet: " & strSheetName & vbNewLine _ 
       & "Chart:   " & strRangeOrChartName, vbCritical 
       On Error GoTo 0: On Error GoTo -1: Err.Clear 
       GoTo lblExit 
      End If 

     Case Table: 
      On Error GoTo lblError 
      Set objMainObject = ThisWorkbook.Worksheets(strSheetName).Range(strRangeOrChartName) 
      objMainObject.Copy 
      objPPT.Activate 
      objSlide.Select 
      objPPT.ActiveWindow.View.Paste 
      For Each objShape In objSlide.Shapes 
       If Ucase(Left(objShape.Name, 5)) = "TABLE" Then 
        Set varPicture = objSlide.Shapes(objShape.Name) 
        Exit For 
       End If 
      Next 
      blnNoError = True lblError: 
      If blnNoError = False Then 
       MsgBox "Range Not Found!" & vbNewLine & vbNewLine & "Range:   " & strRangeOrChartName & _ 
       vbNewLine & "Worksheet: " & strSheetName, vbCritical 
       On Error GoTo 0: On Error GoTo -1: Err.Clear 
       GoTo lblExit 
      End If End Select 
     With varPicture 
     If dblLeftInInches <> 0 Then 
      .Left = dblLeftInInches * 72 
     Else 
      .Left = 33 
     End If 

     If dblTopInInches <> 0 Then 
      .Top = dblTopInInches * 72 
     Else 
      .Top = 118 
     End If 

     If dblHeightInInches <> 0 Then 
      .Height = dblHeightInInches * 72 
     Else 
      .Height = 360 
     End If 

     If dblWidthInInches <> 0 Then 
      .Width = dblWidthInInches * 72 
     Else 
      .Width = 655 
     End If End With 
     objPPT.ActiveWindow.View.Zoom = 100 
    ' objPres.SaveAs ThisWorkbook.Path & "\PPT_" & Format(Now(), "dd_mmm_yyyy") & ".pptx" 
    lblExit: objPPT.WindowState = 2 
     lngLoopFirst = Empty lngLoopSecond = Empty Set objSlide = Nothing Set objTemplate = Nothing Set objLayout = Nothing Set objMainObject = Nothing Set varPicture = Nothing Set 
objShape = Nothing strPathTemplate = Empty Set objFileSystem = 
Nothing Set objFile = Nothing strFileName = Empty Set 
objPresTemp = Nothing blnOpen = Empty Set objPres = Nothing 
     Application.ScreenUpdating = lngStatus lngStatus = Empty 
     If blnNoError = False Then 
     objPPT.Quit 
     End End If 

    End Function 
     ====================================== 
     Option Explicit Option Compare Text 
     Private adoConn    As Object Private adoRset     As Object 
     Private Const mc_strModuleName  As String = "modExportExcelDataToAccess" Private Const strMsgBoxTitle  As 
String = "Uploader" Private Const strDbName    As String = 
"Test.mdb" 
     Sub test() 
     Call ExportDataIntoAccess(_ 
           db_FullPath:=ThisWorkbook.Path & Application.PathSeparator & strDbName, _ 
           db_tblName:="Test" & CLng(Timer), _ 
           xl_FileFullPath:=ThisWorkbook.FullName, _ 
           xl_SheetName:="Sheet1", _ 
           xl_DataRange:="$A$1:$E$200000", _ 
           xl_HeaderYes:=True, _ 
           blnDelTableExistingData:=True) 
    End Sub 
     Sub ExportDataIntoAccess(_ 
          ByVal db_FullPath As String, _ 
          ByVal db_tblName As String, _ 
          ByVal xl_FileFullPath As String, _ 
          ByVal xl_SheetName As String, _ 
          ByVal xl_DataRange As String, _ 
          ByVal xl_HeaderYes As Boolean, _ 
          Optional blnDelTableExistingData As Boolean = False) 


     Dim wbkWorkBook   As Workbook Dim wksWorkSheet  As Worksheet Dim varData    As Variant Dim lngLoopD 
As Long Dim lngLoopA   As Long Dim lngLoop   
As Long Dim lngFldsCount  As Long Dim lngLastCol   
As Long Dim lngLastRow   As Long Dim strSQL    
As String Dim strTemp    As String Dim lngCounter  
As Long Dim dblSum    As Double Dim dbFlds()   
As String Dim dataFlds   As Variant Dim varFound  
As Variant Dim rngFirstCell  As Range Dim rngData  
As Range Dim strAddress   As String Dim lngScreenUp  
As Long Dim lngCalc    As Long Dim dtTime    
As Date 
      dtTime = Time 
      Const DataTypeNumeric As String = "Single" Const DataTypeString As String = "varchar(255)" Const 
DataTypeDateTime As String = "DateTime" 

     'Setting Table Name If Left(db_tblName, 1) <> "[" Then 
     db_tblName = "[" & db_tblName End If If Right(db_tblName, 1) <> "]" Then 
     db_tblName = db_tblName & "]" End If 
      'Checking file path is correct. If Not IsFileExists(xl_FileFullPath) Then Exit Sub 
     'Disabling Application Level Events With Application 
     .EnableEvents = 0 
     lngCalc = .Calculation 
     lngScreenUp = .ScreenUpdating 
     '.ScreenUpdating = 0 
     .DisplayAlerts = 0 
     .Calculation = xlCalculationManual End With 
     'Checking if given file and sheet is available or not On Error Resume Next If Not IsFileOpen(xl_FileFullPath) Then 
     Set wbkWorkBook = Workbooks.Open(xl_FileFullPath) ElseIf LCase(ThisWorkbook.FullName) = LCase(xl_FileFullPath) Then 
     Set wbkWorkBook = ThisWorkbook Else 
     If IsFileOpen(xl_FileFullPath) Then 
      MsgBox "File is already open. Please save file and close it first to upload data.", vbCritical, strMsgBoxTitle 
      GoTo QuickExit 
     Else 
      Set wbkWorkBook = Workbooks.Open(xl_FileFullPath) 
     End If End If Set wksWorkSheet = wbkWorkBook.Worksheets(CStr(xl_SheetName)) 
     'Error handling If Err.Number <> 0 Then 
     MsgBox "Worksheet '" & xl_SheetName & " doesn't exists", vbInformation 
     Err.Clear: On Error GoTo 0 
     GoTo QuickExit End If 
     Call OpenDB(db_FullPath) With wksWorkSheet 

     'Data Range 
     Set rngData = .Range(xl_DataRange) 

     'checking for header if available 
     If xl_HeaderYes Then 
      dataFlds = Application.Transpose(Application.Transpose(rngData.Resize(1))) 
     Else 
      adoRset.Open "Select * From " & db_tblName & " Where 1=2", adoConn, 3, 3 

      ReDim datafld(1 To adoRset.Fields.Count) 
      For lngLoop = 0 To adoRset.Fields.Count - 1 
       Select Case adoRset.Fields(lngLoop).Type 
        Case 202 'adVarWChar 
         datafld(lngLoop + 1) = 202 'advarWChar 
        Case 4 'adSingle 
         datafld(lngLoop + 1) = 4 'adSingle 
        Case 5 'adDouble 
         datafld(lngLoop + 1) = 5 'adDouble 
        Case 7 'adDate 
         datafld(lngLoop + 1) = 7 'adDate 
       End Select 
      Next lngLoop 
     End If 
     varData = rngData End With If LCase(wbkWorkBook.FullName) <> LCase(xl_FileFullPath) Then 
wbkWorkBook.Close (0) 
     On Error GoTo 0 'Checking if table is already exist or not. If Not blnTableExistsInDB(CStr(db_tblName)) Then 
     'Creating table 
     If xl_HeaderYes Then 
      If IsArray(varData) And IsArray(dataFlds) Then 
       strTemp = "Create Table " & CStr(db_tblName) & vbLf & "(" 
       ReDim datafld(1 To UBound(dataFlds, 1)) 
       For lngLoopD = 1 To UBound(dataFlds, 1) 
        If IsNumeric(varData(2, lngLoopD)) And Len(varData(2, lngLoopD)) Then 
         strTemp = strTemp & vbLf & IIf(lngLoopD = 1, "[" & dataFlds(lngLoopD) & "]", ",[" & dataFlds(lngLoopD) & "]") & " 
" & DataTypeNumeric 
         datafld(lngLoopD) = 5 'adDouble 
        ElseIf IsDate(varData(2, lngLoopD)) Then 
         strTemp = strTemp & vbLf & IIf(lngLoopD = 1, "[" & dataFlds(lngLoopD) & "]", ",[" & dataFlds(lngLoopD) & "]") & " 
" & DataTypeDateTime 
         datafld(lngLoopD) = 7 'adDate 
        Else 
         strTemp = strTemp & vbLf & IIf(lngLoopD = 1, "[" & dataFlds(lngLoopD) & "]", ",[" & dataFlds(lngLoopD) & "]") & " 
" & DataTypeString 
         datafld(lngLoopD) = 202 'advarWChar 
        End If 
       Next lngLoopD 
       strTemp = strTemp & vbLf & ")" 
       adoConn.Execute Replace(strTemp, "''", "Null") 
      End If 
     Else 
      If IsArray(varData) Then 
       strTemp = "Create Table " & CStr(db_tblName) & vbLf & "(" 
       For lngLoopD = 1 To UBound(varData, 2) 
        If IsNumeric(varData(2, lngLoopD)) And Len(varData(2, lngLoopD)) Then 
         strTemp = strTemp & vbLf & IIf(lngLoopD = 1, "[Field" & lngLoopD & "]", ",[Field" & lngLoopD & "]") & " " & 
DataTypeNumeric 
        ElseIf IsDate(varData(2, lngLoopD)) Then 
         strTemp = strTemp & vbLf & IIf(lngLoopD = 1, "[Field" & lngLoopD & "]", ",[Field" & lngLoopD & "]") & " " & 
DataTypeNumeric 
        Else 
         strTemp = strTemp & vbLf & IIf(lngLoopD = 1, "[Field" & lngLoopD & "]", ",[Field" & lngLoopD & "]") & " " & 
DataTypeString 
        End If 
       Next lngLoopD 
       strTemp = strTemp & vbLf & ")" 
       adoConn.Execute Replace(strTemp, "''", "Null") 
      End If 
     End If Else 
     'Delete existing data from the table. 
     If blnDelTableExistingData Then 
      strSQL = "Delete * FROM " & CStr(db_tblName) 
      adoConn.Execute strSQL 
     End If End If 
     'Inserting data into the table row by row. On Error GoTo EarlyExit If IsArray(varData) Then 
     For lngLoopD = LBound(varData) + 1 To UBound(varData, 1) 
      strTemp = "INSERT INTO " & CStr(db_tblName) & " VALUES (" 
      For lngLoopA = 1 To UBound(datafld) 

       If datafld(lngLoopA) = 5 Or datafld(lngLoopA) = 4 Then 'adDouble 'adSigle 
        If Not IsEmpty(varData(lngLoopD, lngLoopA)) Then 
         strTemp = strTemp & vbLf & IIf(lngLoopA = 1, varData(lngLoopD, lngLoopA), "," & varData(lngLoopD, lngLoopA)) 
        ElseIf IsEmpty(varData(lngLoopD, lngLoopA)) Then 
         strTemp = strTemp & vbLf & IIf(lngLoopA = 1, "NULL", ",NULL") 
        End If 
       ElseIf datafld(lngLoopA) = 7 Then 'adDate 
        varData(lngLoopD, lngLoopA) = Replace(varData(lngLoopD, lngLoopA), "#", "") 
        varData(lngLoopD, lngLoopA) = Evaluate("=VALUE(""" & varData(lngLoopD, lngLoopA) & """)") 
        strTemp = strTemp & vbLf & IIf(lngLoopA = 1, varData(lngLoopD, lngLoopA), "," & varData(lngLoopD, lngLoopA)) 
       ElseIf datafld(lngLoopA) = 202 Then 'advarWChar 
        varData(lngLoopD, lngLoopA) = Replace(varData(lngLoopD, lngLoopA), "'", "''") 
        varData(lngLoopD, lngLoopA) = Replace(varData(lngLoopD, lngLoopA), """", """""") 
        strTemp = strTemp & vbLf & IIf(lngLoopA = 1, "'" & varData(lngLoopD, lngLoopA) & "'", ",'" & varData(lngLoopD, 
lngLoopA) & "'") 
       End If 

       'Debug.Print strTemp 
      Next lngLoopA 
      strTemp = strTemp & ")" 
      'Debug.Print "ROW: " & lngLoopD ' & ":" & strTemp 
      Call StatusBar(lngLoopD & " Out Of " & UBound(varData) - 1 & " Records inserted into " & db_tblName & " ...") 
      adoConn.Execute Replace(strTemp, "''", "Null") 
     Next lngLoopD 
     Call StatusBar(lngLoopD & "Records are inserted successfully." & vbLf & "Process Started at " & dtTime & " and 
Finished at " & Time) 
     MsgBox lngLoopD & "Records are inserted successfully." & vbLf & "Process Started at " & dtTime & " and Finished at " & Time, 
vbInformation, strMsgBoxTitle 
     Call StatusBar(, False) End If 
    EarlyExit: If Err.Number <> 0 Then 
     MsgBox "Error #:" & Err.Number & vbLf & Err.Description 
     Err.Clear: On Error GoTo 0 
     Stop Else 
     Call StatusBar("", False) End If Erase varData dblSum = Empty dataFlds = Empty QuickExit: With Application 
     .EnableEvents = 1 
     .ScreenUpdating = lngScreenUp 
     .DisplayAlerts = 1 
     .Calculation = lngCalc End With 
     Call CloseDB 
     End Sub 
     Private Function IsFileExists(ByVal FullFileName As String) As Boolean IsFileExists = False On Error Resume Next 
IsFileExists = CBool(Len(Dir(FullFileName))) End Function 
     Private Sub OpenDB(ByVal strDBPath As String) 
     Set adoConn = CreateObject("ADODB.Connection") Set adoRset = CreateObject("ADODB.Recordset") adoConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & CStr(strDBPath) & 
";" 
    End Sub Private Sub CloseDB() 
     On Error Resume Next If adoRset.State <> 0 Then adoRset.Close If adoConn.State <> 0 Then adoConn.Close On 
Error GoTo 0: Err.Clear 
    End Sub 

     Private Function blnTableExistsInDB(strTableName As String) As Boolean 
     Dim rst   As Object Dim strTbl  As String 
     strTbl = strTableName 
     Set rst = adoConn.OpenSchema(20) 'adSchemaTables 
     If Left(strTbl, 1) = "[" And Right(strTbl, 1) = "]" Then 
     strTbl = Mid(strTbl, 2, Len(strTbl) - 2) End If 
     rst.Filter = "TABLE_TYPE='TABLE' and TABLE_NAME='" & strTbl & "'" On Error Resume Next blnTableExistsInDB = 
(Ucase(rst.Fields("TABLE_NAME").Value) = Ucase(strTbl)) On Error 
GoTo 0 If Err.Number <> 0 Then blnTableExistsInDB = False Set 
rst = Nothing 
    End Function 
     Private Function IsFileOpen(ByVal FileName As String) 
     Dim iFilenum As Long Dim iErr As Long 
     On Error Resume Next iFilenum = FreeFile() Open FileName For Input Lock Read As #iFilenum Close iFilenum iErr 
= Err On Error GoTo 0 
     Select Case iErr Case 0: IsFileOpen = False Case 70: IsFileOpen = True Case Else: Error iErr End Select 
    End Function 
     Private Sub StatusBar(Optional strMsg As String = vbNullString, Optional blnShow As Boolean = True) 
     DoEvents If Not blnShow Then Application.StatusBar = blnShow: Exit Sub Application.StatusBar = strMsg 
    End Sub 
+1

Pls formatea la respuesta. Es imposible seguir lo que se ha respondido en el formato actual. –

Cuestiones relacionadas