SEMO.Pa3x قام بنشر مارس 14, 2022 مشاركة قام بنشر مارس 14, 2022 السلام عليكم ورحمة الله وبركاته.. كما في العنوان هذه بعض من دوال الاكسس VBA عسى ولعل تفيدكم. Public Function createFolder(path As String, Optional failIfAlreadyExists As Boolean = False) As Boolean On Error GoTo handleError Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If path <> "" Then FSO.createFolder path End If If folderExists(path) Then createFolder = True Else createFolder = False End If GoTo handleSuccess Exit Function handleSuccess: GoTo cleanUp Exit Function handleError: If Err.Number = 58 And Not failIfAlreadyExists Then createFolder = True Else Call fileSystem.handleError(Err.Number, Err.Description, "createFolder()", path) End If GoTo cleanUp cleanUp: Set FSO = Nothing Exit Function End Function Public Function deleteFile(path As String) As Boolean On Error GoTo handleError Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If path <> "" And fileExists(path) Then FSO.deleteFile path Else Exit Function End If If fileExists(path) Then deleteFile = False Else deleteFile = True End If GoTo handleSuccess Exit Function handleSuccess: Call fileSystem.handleSuccess GoTo cleanUp Exit Function handleError: Call fileSystem.handleError(Err.Number, Err.Description, "deleteFolder()", path) GoTo cleanUp Exit Function cleanUp: Set FSO = Nothing Exit Function End Function Public Function deleteFolder(path As String) As Boolean On Error GoTo handleError Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If path <> "" And folderExists(path) Then path = IIf(Right(path, 1) = "\", Left(path, Len((path)) - 1), path) FSO.deleteFolder path Else Exit Function End If If folderExists(path) Then deleteFolder = False Else deleteFolder = True End If GoTo handleSuccess Exit Function handleSuccess: Call fileSystem.handleSuccess GoTo cleanUp Exit Function handleError: Call fileSystem.handleError(Err.Number, Err.Description, "deleteFolder()", path) GoTo cleanUp cleanUp: Set FSO = Nothing Exit Function End Function Public Function driveExists(path As String) As Boolean On Error GoTo handleError Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If path <> "" Then driveExists = FSO.driveExists(path) End If GoTo handleSuccess Exit Function handleSuccess: Call fileSystem.handleSuccess GoTo cleanUp Exit Function handleError: Call fileSystem.handleError(Err.Number, Err.Description, "driveExists()", path) GoTo cleanUp cleanUp: Set FSO = Nothing Exit Function End Function Public Function fileExists(path As String) As Boolean On Error GoTo handleError Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If path <> "" Then fileExists = FSO.fileExists(path) End If GoTo handleSuccess Exit Function handleSuccess: Call fileSystem.handleSuccess GoTo cleanUp Exit Function handleError: Call fileSystem.handleError(Err.Number, Err.Description, "fileExists()", path) GoTo cleanUp cleanUp: Set FSO = Nothing Exit Function End Function Public Function folderExists(path As String) As Boolean On Error GoTo handleError Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") If path <> "" Then folderExists = FSO.folderExists(path) End If GoTo handleSuccess Exit Function handleSuccess: Call fileSystem.handleSuccess GoTo cleanUp Exit Function handleError: Call fileSystem.handleError(Err.Number, Err.Description, "folderExists()", path) GoTo cleanUp cleanUp: Set FSO = Nothing Exit Function End Function Public Function getComputerName() getComputerName = Environ("COMPUTERNAME") End Function Public Function getUserDesktopPath(Optional endWithSlash As Boolean = True) getUserDesktopPath = getUserProfilePath & "Desktop" & IIf(endWithSlash, "\", "") End Function Public Function getCurrentUsername() getCurrentUsername = Environ("USERNAME") End Function Public Function getUserProfilePath(Optional endWithSlash As Boolean = True) getUserProfilePath = Environ("USERPROFILE") & IIf(endWithSlash, "\", "") End Function Public Function getHomeDrive() getHomeDrive = Environ("HOMEDRIVE") End Function Public Function getHomePath(Optional includeDrive As Boolean = True, Optional endWithSlash As Boolean = True) getHomePath = IIf(includeDrive, getHomeDrive, "") & Environ("HOMEPATH") & IIf(endWithSlash, "\", "") End Function '''''''''''''''''''''''''''' ' ' Name: contains() ' Library: Strings.accda ' Author: Wyatt Castaneda ' Last Update: 23-Mar-19 ' Description: Searchs an arbitary number of strings for a substring ' ' Example(s): contains("wyatt", "wyatt", "james", "amber") --> true ' contains("scott", "wyatt", "james", "amber") --> false ' '''''''''''''''''''''''''''' Public Function contains(toCheck As String, ParamArray searchTerms()) As Boolean Dim term As Variant contains = False For Each term In searchTerms If InStr(toCheck, term) <> 0 Then GoTo doesContainString End If Next Exit Function doesContainString: contains = True Exit Function End Function Public Function lowerCase(toFix As String) As String On Error GoTo failGracefully lowerCase = StrConv(toFix, vbLowerCase) Exit Function failGracefully: lowerCase = toFix Exit Function End Function Public Function upperCase(toFix As String) As String On Error GoTo failGracefully upperCase = StrConv(toFix, vbUpperCase) Exit Function failGracefully: upperCase = toFix Exit Function End Function لا تنسوني ووالدي من صالح دعائكم. 4 رابط هذا التعليق شارك More sharing options...
Moosak قام بنشر مارس 14, 2022 مشاركة قام بنشر مارس 14, 2022 شكرا جزيلا لك أستاذي العزيز وبارك الله فيك ..😊🌹 رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر مارس 14, 2022 مشاركة قام بنشر مارس 14, 2022 بارك الله فيك وفى والديك اخى الكريم وزادك من فضله وكرمه رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان