| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro not recognizing .xlsx spreadsheet
Good Morning:
I am trying to open a macro but when I go to open the worksheet the maco is linking to I cannot because the macro is looking for a .xls spreadsheet instead of the.xlsx file extension. The file I have the maco linked to is a excel 2007 file extension. I do not have the option to change the file extension options to include ..xlsx extensions. Can anyone help me why the macro would not be recognizing a .xlsx spreadsheet? Thank-you Kevin |
|
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
Looks like macro has been written expecting a XLS file (might have been
written before XLSX format came out...). If you can not change the macro then your only choice is to try saving your XLSX file in XLS (Excel 97-2003 format)... "kevgret" wrote: Good Morning: I am trying to open a macro but when I go to open the worksheet the maco is linking to I cannot because the macro is looking for a .xls spreadsheet instead of the.xlsx file extension. The file I have the maco linked to is a excel 2007 file extension. I do not have the option to change the file extension options to include .xlsx extensions. Can anyone help me why the macro would not be recognizing a .xlsx spreadsheet? Thank-you Kevin |
|
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
Which version of Excel are you using?
What do you mean by "open a macro"? What do you mean by "open the worksheet"? Workbooks can be opened. Worksheets cannot be opened. Post the code. Gord Dibben MS Excel MVP On Tue, 17 Mar 2009 07:18:09 -0700, kevgret wrote: Good Morning: I am trying to open a macro but when I go to open the worksheet the maco is linking to I cannot because the macro is looking for a .xls spreadsheet instead of the.xlsx file extension. The file I have the maco linked to is a excel 2007 file extension. I do not have the option to change the file extension options to include .xlsx extensions. Can anyone help me why the macro would not be recognizing a .xlsx spreadsheet? Thank-you Kevin |
|
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
Sheeloo:
Thank you for your help. You are correct. This Macro was written several years ago. Is there any way to update the macro to recognize the .xlsx format? I am weary of saving the file back down to an .xls format because the .xlsx file now has more than 256 columns and I think the old format will chop off anything more than 256 columns. the new excel allows for something like 16,000 columns and the old excel only has something like 256 columns. If I could just "update" the macro to pull up the .xlsx file that would be great. Thanks for your reply. Kevin "Sheeloo" wrote: Looks like macro has been written expecting a XLS file (might have been written before XLSX format came out...). If you can not change the macro then your only choice is to try saving your XLSX file in XLS (Excel 97-2003 format)... "kevgret" wrote: Good Morning: I am trying to open a macro but when I go to open the worksheet the maco is linking to I cannot because the macro is looking for a .xls spreadsheet instead of the.xlsx file extension. The file I have the maco linked to is a excel 2007 file extension. I do not have the option to change the file extension options to include .xlsx extensions. Can anyone help me why the macro would not be recognizing a .xlsx spreadsheet? Thank-you Kevin |
|
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
If is not password protected then you can...
Open the file contatining the macro Press ALT-F11 to open VB Editor... Search for .XLS and replace by .XLSX Or if there is a list of formats... add XLSX to it.... depends on how it has been written... If you can't work it out then post the relevant part of macro here... "kevgret" wrote: Sheeloo: Thank you for your help. You are correct. This Macro was written several years ago. Is there any way to update the macro to recognize the .xlsx format? I am weary of saving the file back down to an .xls format because the .xlsx file now has more than 256 columns and I think the old format will chop off anything more than 256 columns. the new excel allows for something like 16,000 columns and the old excel only has something like 256 columns. If I could just "update" the macro to pull up the .xlsx file that would be great. Thanks for your reply. Kevin "Sheeloo" wrote: Looks like macro has been written expecting a XLS file (might have been written before XLSX format came out...). If you can not change the macro then your only choice is to try saving your XLSX file in XLS (Excel 97-2003 format)... "kevgret" wrote: Good Morning: I am trying to open a macro but when I go to open the worksheet the maco is linking to I cannot because the macro is looking for a .xls spreadsheet instead of the.xlsx file extension. The file I have the maco linked to is a excel 2007 file extension. I do not have the option to change the file extension options to include .xlsx extensions. Can anyone help me why the macro would not be recognizing a .xlsx spreadsheet? Thank-you Kevin |
|
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
"Gord Dibben" wrote: Which version of Excel are you using? I am using excel 2007. What do you mean by "open a macro"? There is a macro on my spreadsheet which links to another workbook. When I click on the maco called "Open Target workbook" I get the option to select the file where my data is stored for the macro. The problem is I can't filter the file extensions for .xlsx. I only have the option to open a .xls format spreadsheet. Post the code. Is this the code? Sub fsCheckData() fsInitializeVariables ' Check the Mapping and Desc fields to ensure we have the same rows in both sheets currRow = 0 For targetRow = targetMappingColumnFirstRow To targetMappingColumnLastRow If Not (Workbooks(targetWorkbook).Worksheets(targetWorksh eet).Rows(targetRow).Hidden) Then If Not (Cells(fsStartRow + currRow, 1).Value = "") And _ (Not (Cells(fsStartRow + currRow, 1).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetMappingColumn).Value) Or _ Not (Cells(fsStartRow + currRow, 2).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField1).Value) Or _ Not (Cells(fsStartRow + currRow, 3).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField2).Value)) Then MsgBox ("Data Mismatch Error for Row " + Trim(Str(fsStartRow + currRow)) + Chr(13) + "Rows data in first three columns of this spreadsheet must match those in target workbook.") Exit Sub End If currRow = currRow + 1 End If Next ' Now, re-copy the formula for the URL delimiter ' Reason: there have been bugs when adding / removing cells (ie: when creating group / folder IDs) ' Easiest fix is to just re-copy as the last step in the process (when the check / set data button is clicked) ' numberOfRows is the number of rows of client data in the IntraLinksFileSplit worksheet numberOfRows = targetMappingColumnLastRow - targetMappingColumnFirstRow Range("P" + Trim(Str(fsTemplateRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.FillDown Range("P" + Trim(Str(fsStartRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.Interior.ColorIndex = xlNone targetNumRows = currRow - 1 'loop through every row and check for data dataCheckList = "" For currRow = fsStartRow To (fsStartRow + targetNumRows) If Not (Cells(currRow, 1) = "") Then If Not ((Cells(currRow, 5).Value = True) Or (Cells(currRow, 5).Value = False)) Then dataCheckList = dataCheckList + "Cell E" + Trim(Str(currRow)) + " must be True or False!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 5).Value = True) Then 'Upload=True If (Worksheets(fsSheetName).Cells(currRow, 4).Value = "") Then 'filename is empty dataCheckList = dataCheckList + "Cell D" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 6).Value = "") Then 'no workspace ID specified dataCheckList = dataCheckList + "Cell F" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 7).Value) = "Error 2042" Then 'folderID lookup failed dataCheckList = dataCheckList + "Cell G" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 9).Value) = "Error 2042" Then 'group ID dataCheckList = dataCheckList + "Cell I" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 11).Value = "SEE") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "CONTROL") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "S") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "C")) Then 'permission type dataCheckList = dataCheckList + "Cell K" + Trim(Str(currRow)) + " must be SEE or CONTROL!" + Chr(13) + Worksheets(fsSheetName).Cells(currRow, 11).Value End If If (Worksheets(fsSheetName).Cells(currRow, 12).Value = "") Then 'pub title dataCheckList = dataCheckList + "Cell L" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 13).Value = "") Then 'effective date dataCheckList = dataCheckList + "Cell M" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOn") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOff") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "D2")) Then 'permission type dataCheckList = dataCheckList + "Cell N" + Trim(Str(currRow)) + " must be DRMOn of DRMOff!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAT") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAF") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAD")) Then 'send alert type dataCheckList = dataCheckList + "Cell O" + Trim(Str(currRow)) + " must be SendAlertTrue or SendAlertFalse!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 16).Value) = "Error 2042" Then 'delimiter is empty dataCheckList = dataCheckList + "Cell P" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If End If End If Next 'Make a call here to the function to check length of PDF names dataCheckList = dataCheckList + CheckLengthOfPDFNames() If (dataCheckList = "") Then ' Set the target column data currRow = 0 For targetRow = targetMappingColumnFirstRow To targetMappingColumnLastRow If Not (Workbooks(targetWorkbook).Worksheets(targetWorksh eet).Rows(targetRow).Hidden) Then If Not (Cells(fsStartRow + currRow, 1) = "") Then ' the following change actually writes the data to the target workbook (rather than just referencing it) ILURLReferenceCellString = "URL:" & Workbooks(fsFileName).Worksheets(fsSheetName).Cell s((fsStartRow + currRow), 16).Value Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetURLColumn) = ILURLReferenceCellString End If currRow = currRow + 1 End If Next MsgBox ("Done Checking Data and Setting URL Data in Target Workbook") Else MsgBox (dataCheckList) MsgBox ("Target URL data not set due to errors!") End If Cells(1, 1).Select End Sub ' ' Private Helper Functions ' Private Function fsWorkbookExists(ByVal workbookName As String) As Boolean ' Checks if the workbook exists For Each w In Workbooks If (w.Name = workbookName) Then fsWorkbookExists = True Exit Function End If Next fsWorkbookExists = False End Function Private Function fsWorksheetExists(ByVal workbookName As String, ByVal sheetName As String) As Boolean ' Checks if the worksheet exists in the workbook For Each s In Workbooks(workbookName).Sheets If (s.Name = sheetName) Then fsWorksheetExists = True Exit Function End If Next fsWorksheetExists = False End Function Public Function CharacterCleanPDFName(text As String, allowSpaces As Boolean) As String ' ' This function cleans a dirty string...changes bad characters to harmless ones. ' Dim tempText tempText = text tempText = Replace(tempText, "/", "_") tempText = Replace(tempText, "\", "_") tempText = Replace(tempText, "|", "_") tempText = Replace(tempText, ":", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "?", "_") tempText = Replace(tempText, """", "_") tempText = Replace(tempText, "<", "_") tempText = Replace(tempText, "", "_") tempText = Replace(tempText, "!", "_") tempText = Replace(tempText, "@", "_") tempText = Replace(tempText, "#", "_") tempText = Replace(tempText, "$", "_") tempText = Replace(tempText, "%", "_") tempText = Replace(tempText, "^", "_") tempText = Replace(tempText, "&", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "=", "_") tempText = Replace(tempText, "~", "_") tempText = Replace(tempText, ",", "_") ' remove apostrophes - currently in production (4.0.25.18) there is a bug that ' does not allow PDFs with apostrophes to be rendered in the browser tempText = Replace(tempText, "'", "") 'just remove apostrophe; don't swap in underscore If Not (allowSpaces) Then tempText = Replace(tempText, " ", "_") End If CharacterCleanPDFName = tempText End Function Public Function CharacterCleanPublication(text As String, allowSpaces As Boolean) As String ' ' This function cleans a dirty string...changes bad characters to harmless ones. ' Dim tempText tempText = text tempText = Replace(tempText, "/", "_") tempText = Replace(tempText, "\", "_") tempText = Replace(tempText, "|", "_") tempText = Replace(tempText, ":", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "?", "_") tempText = Replace(tempText, """", "_") tempText = Replace(tempText, "<", "_") tempText = Replace(tempText, "", "_") tempText = Replace(tempText, "!", "_") tempText = Replace(tempText, "@", "_") tempText = Replace(tempText, "#", "_") tempText = Replace(tempText, "$", "_") tempText = Replace(tempText, "%", "_") tempText = Replace(tempText, "^", "_") tempText = Replace(tempText, "&", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "=", "_") tempText = Replace(tempText, "~", "_") tempText = Replace(tempText, ",", "_") If Not (allowSpaces) Then tempText = Replace(tempText, " ", "_") End If CharacterCleanPublication = tempText End Function Private Function CheckLengthOfPDFNames() As String ' Checks to ensure that PDF name is less than 50 characters ' This is a bug with ARTS Split Pro (PDF Splitter) ' Remove this function when they have fixed this ' This function takes no arguments. It is only called from another sub / function ' that has already set global variables. Uses: ' targetMappingColumnFirstRow ' targetMappingColumnLastRow 'numberOfRows holds the number of rows in the data set numberOfRows = targetMappingColumnLastRow - targetMappingColumnFirstRow + 1 ' lastRow holds the real value of last row of data to be operated on lastRow = fsStartRow + numberOfRows - 1 ' currentRow increments from the 1st data row to the last data row For currentRow = fsStartRow To lastRow If Not (Cells(currentRow, 1) = "") Then 'TO DO : do i need this check ? ' check the length of the current filename If (Len(Cells(currentRow, 4).Value) 50) Then longFileNames = longFileNames + "Row " + Trim(Str(currentRow)) + ": " + Cells(currentRow, 4) + Chr(13) End If End If Next ' as necessary, construct return string If (longFileNames = "") Then CheckLengthOfPDFNames = longFileNames Exit Function End If CheckLengthOfPDFNames = Chr(13) + "Long PDF filenames (max is 50 chars excluding '.pdf'): " + Chr(13) + longFileNames End Function Gord Dibben MS Excel MVP On Tue, 17 Mar 2009 07:18:09 -0700, kevgret wrote: Good Morning: I am trying to open a macro but when I go to open the worksheet the maco is linking to I cannot because the macro is looking for a .xls spreadsheet instead of the.xlsx file extension. The file I have the maco linked to is a excel 2007 file extension. I do not have the option to change the file extension options to include .xlsx extensions. Can anyone help me why the macro would not be recognizing a .xlsx spreadsheet? Thank-you Kevin |
|
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
Hello again:
I think this is the macro that deals with the opening of the workbook. I tried changing the .xls to .xlsx but it still would not open my 2007 workbook. Any suggestions on how to change the macro below to read my 2007 workbook? Option Explicit Private Sub cboSelectWksht_DropButtonClick() Dim strTargetWkbk As String, strTargetWksht As String Dim objWkbk As Workbook, objWksht As Worksheet Dim i As Integer, j As Integer On Error GoTo ErrHandler 'flush combobox j = Application.ActiveSheet.cboSelectWksht.ListCount For i = 0 To j - 1 Application.ActiveSheet.cboSelectWksht.RemoveItem 0 Next i strTargetWkbk = Application.ActiveSheet.txtTargetWkbk If strTargetWkbk = "" Then 'driver is target workbook strTargetWkbk = Application.ActiveWorkbook.Name 'add items to worksheet combo box For Each objWksht In Workbooks(strTargetWkbk).Worksheets strTargetWksht = objWksht.Name If strTargetWksht < "NameMatch" Then Application.ActiveSheet.cboSelectWksht.AddItem strTargetWksht End If Next objWksht Else: 'verify workbook is open For Each objWkbk In Workbooks If objWkbk.Name = strTargetWkbk Then 'populate combobox with worksheets For Each objWksht In Workbooks(strTargetWkbk).Worksheets strTargetWksht = objWksht.Name Application.ActiveSheet.cboSelectWksht.AddItem strTargetWksht Next objWksht End If Next objWkbk End If If Application.ActiveSheet.txtTargetWkbk.Value = "" Then Cells(28, 3) = "this" End If Cells(29, 3) = cboSelectWksht SubExit: Exit Sub ErrHandler: MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly, "Driver Error" GoTo SubExit End Sub Private Sub cmdOpenWkbk_Click() Dim strActiveWkbk As String, strActiveWkSht As String, strTargetWkbkPath As String Dim i As Integer, j As Integer, strTargetWkbkFileName As String, strChk As String Dim w As Worksheet On Error GoTo ErrHandler strActiveWkbk = Application.ActiveWorkbook.Name strActiveWkSht = Application.ActiveSheet.Name strTargetWkbkPath = Application.GetOpenFilename("Microsoft Excel Files(*.xls), *.xls", , "Open Target Workbook (FileSplit Data)", , False) If strTargetWkbkPath < "False" Then 'open file and get filename from returned path + filename Workbooks.Open strTargetWkbkPath i = Len(strTargetWkbkPath) Do strChk = Mid(strTargetWkbkPath, i, 1) i = i - 1 Loop While (strChk < "\") And (strChk < "/") strTargetWkbkFileName = Mid(strTargetWkbkPath, i + 2) 'set text box with filename Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).txtTargetWkbk.Value = strTargetWkbkFileName Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).Cells(28, 3) = strTargetWkbkFileName 'flush combobox j = Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).cboSelectWksht.ListCount For i = 0 To j - 1 Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).cboSelectWksht.RemoveItem 0 Next i 'set cboSelectWksht with worksheets in target workbook For Each w In Workbooks(strTargetWkbkFileName).Worksheets Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).cboSelectWksht.AddItem w.Name Next w End If If Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).txtTargetWkbk.Value = "" Then Cells(28, 3) = "this" End If SubExit: Exit Sub ErrHandler: If Err < 1004 Then MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly, "Driver Error" Else MsgBox "Make sure you have downloaded and saved the FileSplit driver to your computer before using.", vbOKOnly, "Error Opening Workbook" End If GoTo SubExit End Sub Public Sub DataCheck_Click() On Error GoTo ErrHandler fsCheckData ErrExit: Cells(1, 1).Select Exit Sub ErrHandler: MsgBox "Error " & Err.Number & vbNewLine & Err.Description, vbOKOnly, "Driver Error" GoTo ErrExit End Sub "kevgret" wrote: "Gord Dibben" wrote: Which version of Excel are you using? I am using excel 2007. What do you mean by "open a macro"? There is a macro on my spreadsheet which links to another workbook. When I click on the maco called "Open Target workbook" I get the option to select the file where my data is stored for the macro. The problem is I can't filter the file extensions for .xlsx. I only have the option to open a .xls format spreadsheet. Post the code. Is this the code? Sub fsCheckData() fsInitializeVariables ' Check the Mapping and Desc fields to ensure we have the same rows in both sheets currRow = 0 For targetRow = targetMappingColumnFirstRow To targetMappingColumnLastRow If Not (Workbooks(targetWorkbook).Worksheets(targetWorksh eet).Rows(targetRow).Hidden) Then If Not (Cells(fsStartRow + currRow, 1).Value = "") And _ (Not (Cells(fsStartRow + currRow, 1).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetMappingColumn).Value) Or _ Not (Cells(fsStartRow + currRow, 2).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField1).Value) Or _ Not (Cells(fsStartRow + currRow, 3).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField2).Value)) Then MsgBox ("Data Mismatch Error for Row " + Trim(Str(fsStartRow + currRow)) + Chr(13) + "Rows data in first three columns of this spreadsheet must match those in target workbook.") Exit Sub End If currRow = currRow + 1 End If Next ' Now, re-copy the formula for the URL delimiter ' Reason: there have been bugs when adding / removing cells (ie: when creating group / folder IDs) ' Easiest fix is to just re-copy as the last step in the process (when the check / set data button is clicked) ' numberOfRows is the number of rows of client data in the IntraLinksFileSplit worksheet numberOfRows = targetMappingColumnLastRow - targetMappingColumnFirstRow Range("P" + Trim(Str(fsTemplateRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.FillDown Range("P" + Trim(Str(fsStartRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.Interior.ColorIndex = xlNone targetNumRows = currRow - 1 'loop through every row and check for data dataCheckList = "" For currRow = fsStartRow To (fsStartRow + targetNumRows) If Not (Cells(currRow, 1) = "") Then If Not ((Cells(currRow, 5).Value = True) Or (Cells(currRow, 5).Value = False)) Then dataCheckList = dataCheckList + "Cell E" + Trim(Str(currRow)) + " must be True or False!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 5).Value = True) Then 'Upload=True If (Worksheets(fsSheetName).Cells(currRow, 4).Value = "") Then 'filename is empty dataCheckList = dataCheckList + "Cell D" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 6).Value = "") Then 'no workspace ID specified dataCheckList = dataCheckList + "Cell F" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 7).Value) = "Error 2042" Then 'folderID lookup failed dataCheckList = dataCheckList + "Cell G" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 9).Value) = "Error 2042" Then 'group ID dataCheckList = dataCheckList + "Cell I" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 11).Value = "SEE") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "CONTROL") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "S") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "C")) Then 'permission type dataCheckList = dataCheckList + "Cell K" + Trim(Str(currRow)) + " must be SEE or CONTROL!" + Chr(13) + Worksheets(fsSheetName).Cells(currRow, 11).Value End If If (Worksheets(fsSheetName).Cells(currRow, 12).Value = "") Then 'pub title dataCheckList = dataCheckList + "Cell L" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 13).Value = "") Then 'effective date dataCheckList = dataCheckList + "Cell M" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOn") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOff") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "D2")) Then 'permission type dataCheckList = dataCheckList + "Cell N" + Trim(Str(currRow)) + " must be DRMOn of DRMOff!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAT") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAF") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAD")) Then 'send alert type dataCheckList = dataCheckList + "Cell O" + Trim(Str(currRow)) + " must be SendAlertTrue or SendAlertFalse!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 16).Value) = "Error 2042" Then 'delimiter is empty dataCheckList = dataCheckList + "Cell P" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If End If End If Next 'Make a call here to the function to check length of PDF names dataCheckList = dataCheckList + CheckLengthOfPDFNames() If (dataCheckList = "") Then ' Set the target column data currRow = 0 For targetRow = targetMappingColumnFirstRow To targetMappingColumnLastRow If Not (Workbooks(targetWorkbook).Worksheets(targetWorksh eet).Rows(targetRow).Hidden) Then If Not (Cells(fsStartRow + currRow, 1) = "") Then ' the following change actually writes the data to the target workbook (rather than just referencing it) ILURLReferenceCellString = "URL:" & Workbooks(fsFileName).Worksheets(fsSheetName).Cell s((fsStartRow + currRow), 16).Value Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetURLColumn) = ILURLReferenceCellString End If currRow = currRow + 1 End If Next MsgBox ("Done Checking Data and Setting URL Data in Target Workbook") Else MsgBox (dataCheckList) MsgBox ("Target URL data not set due to errors!") End If Cells(1, 1).Select End Sub ' ' Private Helper Functions ' Private Function fsWorkbookExists(ByVal workbookName As String) As Boolean ' Checks if the workbook exists For Each w In Workbooks If (w.Name = workbookName) Then fsWorkbookExists = True Exit Function End If Next fsWorkbookExists = False End Function Private Function fsWorksheetExists(ByVal workbookName As String, ByVal sheetName As String) As Boolean ' Checks if the worksheet exists in the workbook For Each s In Workbooks(workbookName).Sheets If (s.Name = sheetName) Then fsWorksheetExists = True Exit Function End If Next fsWorksheetExists = False End Function Public Function CharacterCleanPDFName(text As String, allowSpaces As Boolean) As String ' ' This function cleans a dirty string...changes bad characters to harmless ones. ' Dim tempText tempText = text tempText = Replace(tempText, "/", "_") tempText = Replace(tempText, "\", "_") tempText = Replace(tempText, "|", "_") tempText = Replace(tempText, ":", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "?", "_") tempText = Replace(tempText, """", "_") tempText = Replace(tempText, "<", "_") tempText = Replace(tempText, "", "_") tempText = Replace(tempText, "!", "_") tempText = Replace(tempText, "@", "_") tempText = Replace(tempText, "#", "_") tempText = Replace(tempText, "$", "_") tempText = Replace(tempText, "%", "_") tempText = Replace(tempText, "^", "_") tempText = Replace(tempText, "&", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "=", "_") tempText = Replace(tempText, "~", "_") tempText = Replace(tempText, ",", "_") ' remove apostrophes - currently in production (4.0.25.18) there is a bug that ' does not allow PDFs with apostrophes to be rendered in the browser tempText = Replace(tempText, "'", "") 'just remove apostrophe; don't swap in underscore If Not (allowSpaces) Then tempText = Replace(tempText, " ", "_") End If CharacterCleanPDFName = tempText End Function Public Function CharacterCleanPublication(text As String, allowSpaces As Boolean) As String ' ' This function cleans a dirty string...changes bad characters to harmless ones. ' Dim tempText tempText = text tempText = Replace(tempText, "/", "_") tempText = Replace(tempText, "\", "_") tempText = Replace(tempText, "|", "_") tempText = Replace(tempText, ":", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "?", "_") tempText = Replace(tempText, """", "_") tempText = Replace(tempText, "<", "_") tempText = Replace(tempText, "", "_") tempText = Replace(tempText, "!", "_") tempText = Replace(tempText, "@", "_") tempText = Replace(tempText, "#", "_") tempText = Replace(tempText, "$", "_") tempText = Replace(tempText, "%", "_") tempText = Replace(tempText, "^", "_") tempText = Replace(tempText, "&", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "=", "_") tempText = Replace(tempText, "~", "_") tempText = Replace(tempText, ",", "_") If Not (allowSpaces) Then tempText = Replace(tempText, " ", "_") End If CharacterCleanPublication = tempText End Function Private Function CheckLengthOfPDFNames() As String ' Checks to ensure that PDF name is less than 50 characters ' This is a bug with ARTS Split Pro (PDF Splitter) ' Remove this function when they have fixed this ' This function takes no arguments. It is only called from another sub / function ' that has already set global variables. Uses: ' targetMappingColumnFirstRow ' targetMappingColumnLastRow 'numberOfRows holds the number of rows in the data set |
|
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
Did you change in the line
Files(*.xls), *.xls", , "Open Target Workbook (FileSplit Data)", , False) If yes, then what is the error you are getting? Also do you have FileSplit driver? Do remember that in Excel 2007 workbooks with macros are named XLSM MsgBox "Make sure you have downloaded and saved the FileSplit driver to your computer before using.", vbOKOnly, "Error Opening Workbook" "kevgret" wrote: Hello again: I think this is the macro that deals with the opening of the workbook. I tried changing the .xls to .xlsx but it still would not open my 2007 workbook. Any suggestions on how to change the macro below to read my 2007 workbook? Option Explicit Private Sub cboSelectWksht_DropButtonClick() Dim strTargetWkbk As String, strTargetWksht As String Dim objWkbk As Workbook, objWksht As Worksheet Dim i As Integer, j As Integer On Error GoTo ErrHandler 'flush combobox j = Application.ActiveSheet.cboSelectWksht.ListCount For i = 0 To j - 1 Application.ActiveSheet.cboSelectWksht.RemoveItem 0 Next i strTargetWkbk = Application.ActiveSheet.txtTargetWkbk If strTargetWkbk = "" Then 'driver is target workbook strTargetWkbk = Application.ActiveWorkbook.Name 'add items to worksheet combo box For Each objWksht In Workbooks(strTargetWkbk).Worksheets strTargetWksht = objWksht.Name If strTargetWksht < "NameMatch" Then Application.ActiveSheet.cboSelectWksht.AddItem strTargetWksht End If Next objWksht Else: 'verify workbook is open For Each objWkbk In Workbooks If objWkbk.Name = strTargetWkbk Then 'populate combobox with worksheets For Each objWksht In Workbooks(strTargetWkbk).Worksheets strTargetWksht = objWksht.Name Application.ActiveSheet.cboSelectWksht.AddItem strTargetWksht Next objWksht End If Next objWkbk End If If Application.ActiveSheet.txtTargetWkbk.Value = "" Then Cells(28, 3) = "this" End If Cells(29, 3) = cboSelectWksht SubExit: Exit Sub ErrHandler: MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly, "Driver Error" GoTo SubExit End Sub Private Sub cmdOpenWkbk_Click() Dim strActiveWkbk As String, strActiveWkSht As String, strTargetWkbkPath As String Dim i As Integer, j As Integer, strTargetWkbkFileName As String, strChk As String Dim w As Worksheet On Error GoTo ErrHandler strActiveWkbk = Application.ActiveWorkbook.Name strActiveWkSht = Application.ActiveSheet.Name strTargetWkbkPath = Application.GetOpenFilename("Microsoft Excel Files(*.xls), *.xls", , "Open Target Workbook (FileSplit Data)", , False) If strTargetWkbkPath < "False" Then 'open file and get filename from returned path + filename Workbooks.Open strTargetWkbkPath i = Len(strTargetWkbkPath) Do strChk = Mid(strTargetWkbkPath, i, 1) i = i - 1 Loop While (strChk < "\") And (strChk < "/") strTargetWkbkFileName = Mid(strTargetWkbkPath, i + 2) 'set text box with filename Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).txtTargetWkbk.Value = strTargetWkbkFileName Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).Cells(28, 3) = strTargetWkbkFileName 'flush combobox j = Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).cboSelectWksht.ListCount For i = 0 To j - 1 Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).cboSelectWksht.RemoveItem 0 Next i 'set cboSelectWksht with worksheets in target workbook For Each w In Workbooks(strTargetWkbkFileName).Worksheets Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).cboSelectWksht.AddItem w.Name Next w End If If Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).txtTargetWkbk.Value = "" Then Cells(28, 3) = "this" End If SubExit: Exit Sub ErrHandler: If Err < 1004 Then MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly, "Driver Error" Else MsgBox "Make sure you have downloaded and saved the FileSplit driver to your computer before using.", vbOKOnly, "Error Opening Workbook" End If GoTo SubExit End Sub Public Sub DataCheck_Click() On Error GoTo ErrHandler fsCheckData ErrExit: Cells(1, 1).Select Exit Sub ErrHandler: MsgBox "Error " & Err.Number & vbNewLine & Err.Description, vbOKOnly, "Driver Error" GoTo ErrExit End Sub "kevgret" wrote: "Gord Dibben" wrote: Which version of Excel are you using? I am using excel 2007. What do you mean by "open a macro"? There is a macro on my spreadsheet which links to another workbook. When I click on the maco called "Open Target workbook" I get the option to select the file where my data is stored for the macro. The problem is I can't filter the file extensions for .xlsx. I only have the option to open a .xls format spreadsheet. Post the code. Is this the code? Sub fsCheckData() fsInitializeVariables ' Check the Mapping and Desc fields to ensure we have the same rows in both sheets currRow = 0 For targetRow = targetMappingColumnFirstRow To targetMappingColumnLastRow If Not (Workbooks(targetWorkbook).Worksheets(targetWorksh eet).Rows(targetRow).Hidden) Then If Not (Cells(fsStartRow + currRow, 1).Value = "") And _ (Not (Cells(fsStartRow + currRow, 1).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetMappingColumn).Value) Or _ Not (Cells(fsStartRow + currRow, 2).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField1).Value) Or _ Not (Cells(fsStartRow + currRow, 3).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField2).Value)) Then MsgBox ("Data Mismatch Error for Row " + Trim(Str(fsStartRow + currRow)) + Chr(13) + "Rows data in first three columns of this spreadsheet must match those in target workbook.") Exit Sub End If currRow = currRow + 1 End If Next ' Now, re-copy the formula for the URL delimiter ' Reason: there have been bugs when adding / removing cells (ie: when creating group / folder IDs) ' Easiest fix is to just re-copy as the last step in the process (when the check / set data button is clicked) ' numberOfRows is the number of rows of client data in the IntraLinksFileSplit worksheet numberOfRows = targetMappingColumnLastRow - targetMappingColumnFirstRow Range("P" + Trim(Str(fsTemplateRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.FillDown Range("P" + Trim(Str(fsStartRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.Interior.ColorIndex = xlNone targetNumRows = currRow - 1 'loop through every row and check for data dataCheckList = "" For currRow = fsStartRow To (fsStartRow + targetNumRows) If Not (Cells(currRow, 1) = "") Then If Not ((Cells(currRow, 5).Value = True) Or (Cells(currRow, 5).Value = False)) Then dataCheckList = dataCheckList + "Cell E" + Trim(Str(currRow)) + " must be True or False!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 5).Value = True) Then 'Upload=True If (Worksheets(fsSheetName).Cells(currRow, 4).Value = "") Then 'filename is empty dataCheckList = dataCheckList + "Cell D" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 6).Value = "") Then 'no workspace ID specified dataCheckList = dataCheckList + "Cell F" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 7).Value) = "Error 2042" Then 'folderID lookup failed dataCheckList = dataCheckList + "Cell G" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 9).Value) = "Error 2042" Then 'group ID dataCheckList = dataCheckList + "Cell I" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 11).Value = "SEE") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "CONTROL") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "S") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "C")) Then 'permission type dataCheckList = dataCheckList + "Cell K" + Trim(Str(currRow)) + " must be SEE or CONTROL!" + Chr(13) + Worksheets(fsSheetName).Cells(currRow, 11).Value End If If (Worksheets(fsSheetName).Cells(currRow, 12).Value = "") Then 'pub title dataCheckList = dataCheckList + "Cell L" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 13).Value = "") Then 'effective date dataCheckList = dataCheckList + "Cell M" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOn") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOff") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "D2")) Then 'permission type dataCheckList = dataCheckList + "Cell N" + Trim(Str(currRow)) + " must be DRMOn of DRMOff!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAT") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAF") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAD")) Then 'send alert type dataCheckList = dataCheckList + "Cell O" + Trim(Str(currRow)) + " must be SendAlertTrue or SendAlertFalse!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 16).Value) = "Error 2042" Then 'delimiter is empty dataCheckList = dataCheckList + "Cell P" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If End If End If Next 'Make a call here to the function to check length of PDF names dataCheckList = dataCheckList + CheckLengthOfPDFNames() If (dataCheckList = "") Then ' Set the target column data |
|
#9
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Macro not recognizing .xlsx spreadsheet
This example modification pops up the FileOpen dialog with *.xlxs as default
"Files of type" Private Sub cmdOpenWkbk_Click() strActiveWkbk = Application.ActiveWorkbook.Name strActiveWkSht = Application.ActiveSheet.Name strTargetWkbkPath = Application.GetOpenFilename("Microsoft Excel Files(*.xlxs), *.xlxs", , "Open Target Workbook (FileSplit Data)", , False) End sub On Tue, 17 Mar 2009 08:45:03 -0700, kevgret wrote: Hello again: I think this is the macro that deals with the opening of the workbook. I tried changing the .xls to .xlsx but it still would not open my 2007 workbook. Any suggestions on how to change the macro below to read my 2007 workbook? Option Explicit Private Sub cboSelectWksht_DropButtonClick() Dim strTargetWkbk As String, strTargetWksht As String Dim objWkbk As Workbook, objWksht As Worksheet Dim i As Integer, j As Integer On Error GoTo ErrHandler 'flush combobox j = Application.ActiveSheet.cboSelectWksht.ListCount For i = 0 To j - 1 Application.ActiveSheet.cboSelectWksht.RemoveItem 0 Next i strTargetWkbk = Application.ActiveSheet.txtTargetWkbk If strTargetWkbk = "" Then 'driver is target workbook strTargetWkbk = Application.ActiveWorkbook.Name 'add items to worksheet combo box For Each objWksht In Workbooks(strTargetWkbk).Worksheets strTargetWksht = objWksht.Name If strTargetWksht < "NameMatch" Then Application.ActiveSheet.cboSelectWksht.AddItem strTargetWksht End If Next objWksht Else: 'verify workbook is open For Each objWkbk In Workbooks If objWkbk.Name = strTargetWkbk Then 'populate combobox with worksheets For Each objWksht In Workbooks(strTargetWkbk).Worksheets strTargetWksht = objWksht.Name Application.ActiveSheet.cboSelectWksht.AddItem strTargetWksht Next objWksht End If Next objWkbk End If If Application.ActiveSheet.txtTargetWkbk.Value = "" Then Cells(28, 3) = "this" End If Cells(29, 3) = cboSelectWksht SubExit: Exit Sub ErrHandler: MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly, "Driver Error" GoTo SubExit End Sub Private Sub cmdOpenWkbk_Click() Dim strActiveWkbk As String, strActiveWkSht As String, strTargetWkbkPath As String Dim i As Integer, j As Integer, strTargetWkbkFileName As String, strChk As String Dim w As Worksheet On Error GoTo ErrHandler strActiveWkbk = Application.ActiveWorkbook.Name strActiveWkSht = Application.ActiveSheet.Name strTargetWkbkPath = Application.GetOpenFilename("Microsoft Excel Files(*.xls), *.xls", , "Open Target Workbook (FileSplit Data)", , False) If strTargetWkbkPath < "False" Then 'open file and get filename from returned path + filename Workbooks.Open strTargetWkbkPath i = Len(strTargetWkbkPath) Do strChk = Mid(strTargetWkbkPath, i, 1) i = i - 1 Loop While (strChk < "\") And (strChk < "/") strTargetWkbkFileName = Mid(strTargetWkbkPath, i + 2) 'set text box with filename Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).txtTargetWkbk.Value = strTargetWkbkFileName Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).Cells(28, 3) = strTargetWkbkFileName 'flush combobox j = Workbooks(strActiveWkbk).Worksheets(strActiveWkSh t).cboSelectWksht.ListCount For i = 0 To j - 1 Workbooks(strActiveWkbk).Worksheets(strActiveWkSh t).cboSelectWksht.RemoveItem 0 Next i 'set cboSelectWksht with worksheets in target workbook For Each w In Workbooks(strTargetWkbkFileName).Worksheets Workbooks(strActiveWkbk).Worksheets(strActiveWkSh t).cboSelectWksht.AddItem w.Name Next w End If If Workbooks(strActiveWkbk).Worksheets(strActiveWkSht ).txtTargetWkbk.Value = "" Then Cells(28, 3) = "this" End If SubExit: Exit Sub ErrHandler: If Err < 1004 Then MsgBox "Error " & Err.Number & vbNewLine & vbNewLine & Err.Description, vbOKOnly, "Driver Error" Else MsgBox "Make sure you have downloaded and saved the FileSplit driver to your computer before using.", vbOKOnly, "Error Opening Workbook" End If GoTo SubExit End Sub Public Sub DataCheck_Click() On Error GoTo ErrHandler fsCheckData ErrExit: Cells(1, 1).Select Exit Sub ErrHandler: MsgBox "Error " & Err.Number & vbNewLine & Err.Description, vbOKOnly, "Driver Error" GoTo ErrExit End Sub "kevgret" wrote: "Gord Dibben" wrote: Which version of Excel are you using? I am using excel 2007. What do you mean by "open a macro"? There is a macro on my spreadsheet which links to another workbook. When I click on the maco called "Open Target workbook" I get the option to select the file where my data is stored for the macro. The problem is I can't filter the file extensions for .xlsx. I only have the option to open a .xls format spreadsheet. Post the code. Is this the code? Sub fsCheckData() fsInitializeVariables ' Check the Mapping and Desc fields to ensure we have the same rows in both sheets currRow = 0 For targetRow = targetMappingColumnFirstRow To targetMappingColumnLastRow If Not (Workbooks(targetWorkbook).Worksheets(targetWorksh eet).Rows(targetRow).Hidden) Then If Not (Cells(fsStartRow + currRow, 1).Value = "") And _ (Not (Cells(fsStartRow + currRow, 1).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetMappingColumn).Value) Or _ Not (Cells(fsStartRow + currRow, 2).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField1).Value) Or _ Not (Cells(fsStartRow + currRow, 3).Value = Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetDescField2).Value)) Then MsgBox ("Data Mismatch Error for Row " + Trim(Str(fsStartRow + currRow)) + Chr(13) + "Rows data in first three columns of this spreadsheet must match those in target workbook.") Exit Sub End If currRow = currRow + 1 End If Next ' Now, re-copy the formula for the URL delimiter ' Reason: there have been bugs when adding / removing cells (ie: when creating group / folder IDs) ' Easiest fix is to just re-copy as the last step in the process (when the check / set data button is clicked) ' numberOfRows is the number of rows of client data in the IntraLinksFileSplit worksheet numberOfRows = targetMappingColumnLastRow - targetMappingColumnFirstRow Range("P" + Trim(Str(fsTemplateRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.FillDown Range("P" + Trim(Str(fsStartRow)) + ":P" + Trim(Str(fsStartRow + numberOfRows))).Select Selection.Interior.ColorIndex = xlNone targetNumRows = currRow - 1 'loop through every row and check for data dataCheckList = "" For currRow = fsStartRow To (fsStartRow + targetNumRows) If Not (Cells(currRow, 1) = "") Then If Not ((Cells(currRow, 5).Value = True) Or (Cells(currRow, 5).Value = False)) Then dataCheckList = dataCheckList + "Cell E" + Trim(Str(currRow)) + " must be True or False!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 5).Value = True) Then 'Upload=True If (Worksheets(fsSheetName).Cells(currRow, 4).Value = "") Then 'filename is empty dataCheckList = dataCheckList + "Cell D" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 6).Value = "") Then 'no workspace ID specified dataCheckList = dataCheckList + "Cell F" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 7).Value) = "Error 2042" Then 'folderID lookup failed dataCheckList = dataCheckList + "Cell G" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 9).Value) = "Error 2042" Then 'group ID dataCheckList = dataCheckList + "Cell I" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 11).Value = "SEE") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "CONTROL") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "S") Or (Worksheets(fsSheetName).Cells(currRow, 11).Value = "C")) Then 'permission type dataCheckList = dataCheckList + "Cell K" + Trim(Str(currRow)) + " must be SEE or CONTROL!" + Chr(13) + Worksheets(fsSheetName).Cells(currRow, 11).Value End If If (Worksheets(fsSheetName).Cells(currRow, 12).Value = "") Then 'pub title dataCheckList = dataCheckList + "Cell L" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If (Worksheets(fsSheetName).Cells(currRow, 13).Value = "") Then 'effective date dataCheckList = dataCheckList + "Cell M" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOn") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "DRMOff") Or (Worksheets(fsSheetName).Cells(currRow, 14).Value = "D2")) Then 'permission type dataCheckList = dataCheckList + "Cell N" + Trim(Str(currRow)) + " must be DRMOn of DRMOff!" + Chr(13) End If If Not ((Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAT") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAF") Or (Worksheets(fsSheetName).Cells(currRow, 15).Value = "SAD")) Then 'send alert type dataCheckList = dataCheckList + "Cell O" + Trim(Str(currRow)) + " must be SendAlertTrue or SendAlertFalse!" + Chr(13) End If If CStr(Worksheets(fsSheetName).Cells(currRow, 16).Value) = "Error 2042" Then 'delimiter is empty dataCheckList = dataCheckList + "Cell P" + Trim(Str(currRow)) + " is empty!" + Chr(13) End If End If End If Next 'Make a call here to the function to check length of PDF names dataCheckList = dataCheckList + CheckLengthOfPDFNames() If (dataCheckList = "") Then ' Set the target column data currRow = 0 For targetRow = targetMappingColumnFirstRow To targetMappingColumnLastRow If Not (Workbooks(targetWorkbook).Worksheets(targetWorksh eet).Rows(targetRow).Hidden) Then If Not (Cells(fsStartRow + currRow, 1) = "") Then ' the following change actually writes the data to the target workbook (rather than just referencing it) ILURLReferenceCellString = "URL:" & Workbooks(fsFileName).Worksheets(fsSheetName).Cell s((fsStartRow + currRow), 16).Value Workbooks(targetWorkbook).Sheets(targetWorksheet). Cells(targetRow, targetURLColumn) = ILURLReferenceCellString End If currRow = currRow + 1 End If Next MsgBox ("Done Checking Data and Setting URL Data in Target Workbook") Else MsgBox (dataCheckList) MsgBox ("Target URL data not set due to errors!") End If Cells(1, 1).Select End Sub ' ' Private Helper Functions ' Private Function fsWorkbookExists(ByVal workbookName As String) As Boolean ' Checks if the workbook exists For Each w In Workbooks If (w.Name = workbookName) Then fsWorkbookExists = True Exit Function End If Next fsWorkbookExists = False End Function Private Function fsWorksheetExists(ByVal workbookName As String, ByVal sheetName As String) As Boolean ' Checks if the worksheet exists in the workbook For Each s In Workbooks(workbookName).Sheets If (s.Name = sheetName) Then fsWorksheetExists = True Exit Function End If Next fsWorksheetExists = False End Function Public Function CharacterCleanPDFName(text As String, allowSpaces As Boolean) As String ' ' This function cleans a dirty string...changes bad characters to harmless ones. ' Dim tempText tempText = text tempText = Replace(tempText, "/", "_") tempText = Replace(tempText, "\", "_") tempText = Replace(tempText, "|", "_") tempText = Replace(tempText, ":", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "?", "_") tempText = Replace(tempText, """", "_") tempText = Replace(tempText, "<", "_") tempText = Replace(tempText, "", "_") tempText = Replace(tempText, "!", "_") tempText = Replace(tempText, "@", "_") tempText = Replace(tempText, "#", "_") tempText = Replace(tempText, "$", "_") tempText = Replace(tempText, "%", "_") tempText = Replace(tempText, "^", "_") tempText = Replace(tempText, "&", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "=", "_") tempText = Replace(tempText, "~", "_") tempText = Replace(tempText, ",", "_") ' remove apostrophes - currently in production (4.0.25.18) there is a bug that ' does not allow PDFs with apostrophes to be rendered in the browser tempText = Replace(tempText, "'", "") 'just remove apostrophe; don't swap in underscore If Not (allowSpaces) Then tempText = Replace(tempText, " ", "_") End If CharacterCleanPDFName = tempText End Function Public Function CharacterCleanPublication(text As String, allowSpaces As Boolean) As String ' ' This function cleans a dirty string...changes bad characters to harmless ones. ' Dim tempText tempText = text tempText = Replace(tempText, "/", "_") tempText = Replace(tempText, "\", "_") tempText = Replace(tempText, "|", "_") tempText = Replace(tempText, ":", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "?", "_") tempText = Replace(tempText, """", "_") tempText = Replace(tempText, "<", "_") tempText = Replace(tempText, "", "_") tempText = Replace(tempText, "!", "_") tempText = Replace(tempText, "@", "_") tempText = Replace(tempText, "#", "_") tempText = Replace(tempText, "$", "_") tempText = Replace(tempText, "%", "_") tempText = Replace(tempText, "^", "_") tempText = Replace(tempText, "&", "_") tempText = Replace(tempText, "*", "_") tempText = Replace(tempText, "=", "_") tempText = Replace(tempText, "~", "_") tempText = Replace(tempText, ",", "_") If Not (allowSpaces) Then tempText = Replace(tempText, " ", "_") End If CharacterCleanPublication = tempText End Function Private Function CheckLengthOfPDFNames() As String ' Checks to ensure that PDF name is less than 50 characters ' This is a bug with ARTS Split Pro (PDF Splitter) ' Remove this function when they have fixed this ' This function takes no arguments. It is only called from another sub / function ' that has already set global variables. Uses: ' targetMappingColumnFirstRow ' targetMappingColumnLastRow 'numberOfRows holds the number of rows in the data set |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Saving as .xlsx from VBA MACRO | Excel Discussion (Misc queries) | |||
| How do I set default Excel Saveas file format to xlsx not xlsx | Setting up and Configuration of Excel | |||
| Macro to copy and append spreadsheet changes to new spreadsheet | Excel Discussion (Misc queries) | |||
| Macro not recognizing blank lines as blank | Excel Discussion (Misc queries) | |||
| Is there a way to insert a formula, password or macro in an excel spreadsheet that will automatically delete the spreadsheet? | Excel Discussion (Misc queries) | |||
Linear Mode
